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
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
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments