VBA paste formulas from filtered column

is there a way in Excel (VBA) to copy / paste formulas from a filtered column in statement 1? It 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 tainted rows (possibly because the columns are being 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 is possible to do this without using the clipboard in expression 1?

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 the formula "= Dn / $ A $ 3 * 100, where n is the row number. Formulas B and C are divided by cell B3 and C3. Then I filter Sheet1, copy the filtered rows and paste them into 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

      

+3


source to share


1 answer


This can be done, but converting the formula to a different sheet presents problems. The formula can be selected in a loop, but the cell addresses must be changed to reflect the original sheet name. If the Application.ConvertFormula method is applied and the formula is converted to strictly xlAbsolute style, then each $ can be checked to see if the name of the original worksheet is appropriate. The formula you provided (for example = Dn / $ A $ 3 * 100) is pretty simple and shouldn't cause any problems.

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 never intended to pass the name of the original worksheet along with the formula, then a lot of the code can be dropped.

0


source







All Articles