Search code examples
excelvbaexcel-formulaexcel-2010vba6

How to copy specific columns and filtered rows into another worksheet


Please, I need some help with my code. I filtered some rows using VBA and would like to copy only two columns instead of all columns.

Public Sub CheckPrKey()
lastRow = Worksheets("ETM_ACS2").Range("A" & Rows.Count).End(xlUp).Row

  For r = 2 To lastRow
     If Worksheets("ETM_ACS2").Range("I" & r).Value = "Y" And Worksheets("ETM_ACS2").Range("N" & r).Value < "100" Then
   Worksheets("ETM_ACS2").Range("D, N" & r).Copy
   **Worksheets("ETM_ACS2").Rows(r).Copy**
   
   Worksheets("dashboard").Activate
   lastRowdashboard = Worksheets("dashboard").Range("B" & Rows.Count).End(xlUp).Row
   Worksheets("dashboard").Range("A" & lastRowdashboard + 1).Select
   
   ActiveSheet.Paste
End If

Next r
ActiveCell.Offset(1, 0).Select

End Sub

Solution

  • I'm not sure that got the point, but try.

    Public Sub CheckPrKey()
        lastRow = Worksheets("ETM_ACS2").Range("A" & Rows.Count).End(xlUp).Row
        lastRowdashboard = Worksheets("dashboard").Range("B" & Rows.Count).End(xlUp).Row
        
        With Worksheets("ETM_ACS2")
            For r = 2 To lastRow
                    
                If .Range("I" & r).Value = "Y" 
                    If .Range("N" & r).Value < "100" Then
    
                        Worksheets("dashboard").Range("A" & lastRowdashboard + 1)=.Range("D" & r)
                        Worksheets("dashboard").Range("B" & lastRowdashboard + 1)=.Range("N" & r)
                        lastRowdashboard =  lastRowdashboard +1             
                    End if
                End If
            Next r
        End With
    
    End Sub