How to copy specific columns and filtered rows into another worksheet-CodePudding

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

CodePudding user response：

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