VBA paste formulas from filtered column

Question

is there way in Excel(VBA) to copy/paste formulas from filtered column in 1 statement ? This works :

Sheets(1).Range("A2:C" & LastRow).Copy
Sheets(2).Range("A2:C" & Range("D" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteFormulas

But this returns messed up rows (probably because column is filtered) :

Sheets(2).Range("A2:C" & Range("D" & Rows.Count).End(xlUp).Row).Formula = Sheets(1).Range("A2:C" & LastRow).Formula

any ideas if it's possible to do it without using clipboard, in 1 statement ?

EDIT

In Sheet1, I add formulas to columns A,B and C:

With Sheets(1)
    LastRow = .Range("D" & Rows.Count).End(xlUp).Row
    .Range("A5:A" & LastRow).Value = "=D5/$A$3*100"
    .Range("A:AG").AutoFilter Field:=22, Criteria1:=">=1/1/2014", Operator:=xlAnd, Criteria2:="<=12/31/2014"
    .Range("B5:B" & LastRow).SpecialCells(xlCellTypeVisible).Value = "=D" & .UsedRange.Offset(5, 0).SpecialCells(xlCellTypeVisible).Row & "/$B$3*100"
    .Range("A:AG").AutoFilter Field:=22, Criteria1:=">=1/1/2015"
    .Range("C5:C" & LastRow).SpecialCells(xlCellTypeVisible).Value = "=D" & .UsedRange.Offset(5, 0).SpecialCells(xlCellTypeVisible).Row & "/$C$3*100"
    .ShowAllData
End With

Therefore column A has formula "=Dn/$A$3*100, where n is row number. B and C formulas have division by B3 and C3 cell value. Then I filter Sheet1, copy filtered rows and paste them to Sheet2

Sheets(1).Range("A4:AG" & LastRow).AutoFilter Field:=7, Criteria1:=name
Sheets(1).Range("A5:C" & LastRow).Copy
Sheets(2).Range("A5:C" & Range("D" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteFormulas

Have you tried with .FormulaLocal rather than .Formula? There is also .FormulaHidden and .FormulaArray that might be helpful. — R3uK
I tried it and it didn't work, correct values only before first excluded row by filter. thank for suggestion anyway — mauek unak
Maybe there is something to dig with Enum XlCellType, containing : Const xlCellTypeFormulas = -4123 (&HFFFFEFE5) and Const xlCellTypeVisible = 12 — R3uK
Can you add a picture of an example of the formula? Which sheet is filtered? The copy side or the paste side? Beware that .End will skip hidden cells which becomes relevant when you have filtered data. Can you also show where LastRow comes from? I bumped your rep past 10, so you can post a picture. — Byron Wall

Unknown Unknown · Accepted Answer · 2015-06-05T09:31:05

This can be done but bringing the formula to another worksheet presents problems. The formula can be picked up in a loop but needs to have the cell addresses modified to reflect the original worksheet name. If the Application.ConvertFormula method is applied and the formula is converted to a strictly xlAbsolute style, then each $ could be examined to see if prefacing with the original worksheet name is appropriate. The formula you've supplied (e.g. =Dn/$A$3*100) is fairly straightforward and shouldn't present any problems parsing out.

Sub Copy_Filtered_Formulas()
    Dim lr As Long, lc As Long, rVIS As Range
    Dim vr As Long, vc As Long, sFRML As String, p As Long
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    With ws2
        If Not IsEmpty(.Cells(5, 1)) Then
            With .Range(.Cells(5, 1), .Cells(Rows.Count, 1).End(xlUp))
                .Resize(.Rows.Count, 3).ClearContents
            End With
        End If
    End With

    With ws1
        If .AutoFilterMode Then .AutoFilterMode = False
        lc = .Range("AG:AG").Column
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        With .Cells(4, 1).Resize(lr - 3, lc)
            With .Offset(1, 0).Resize(.Rows.Count - 1, 3)
                .Formula = "=$D5/A$3*100"
            End With
            .AutoFilter field:=7, Criteria1:=0
            With .Offset(1, 0).Resize(.Rows.Count - 1, 3)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    For Each rVIS In Intersect(.SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeFormulas))
                        sFRML = Application.ConvertFormula(rVIS.FormulaR1C1, xlR1C1, xlA1, xlAbsolute, rVIS)
                        p = InStr(1, sFRML, Chr(36))
                        Do While CBool(p)
                            If Asc(Mid(sFRML, p + 1, 1)) >= 65 And _
                              Asc(Mid(sFRML, p + 1, 1)) <= 90 And _
                              Asc(Mid(sFRML, p - 1, 1)) <> 33 And _
                              Asc(Mid(sFRML, p - 1, 1)) <> 58 Then
                                sFRML = Left(sFRML, p - 1) & Chr(39) & .Parent.Name & Chr(39) & Chr(33) & Mid(sFRML, p, 999)
                                p = InStr(p + Len(.Parent.Name) + 5, sFRML, Chr(36))
                            Else
                                p = InStr(p + 3, sFRML, Chr(36))
                            End If
                        Loop
                        With ws2
                            .Cells(Rows.Count, rVIS.Column).End(xlUp).Offset(1, 0).Formula = sFRML
                        End With
                    Next rVIS
                End If
            End With
        End With
    End With
End Sub

Of course, if you had never intended to transfer the original worksheet's name along with the formula then a lot of the code can be discarded.

VBA paste formulas from filtered column

1 Answers