copy/paste using VBA

Gary Lens
Gary Lens used Ask the Experts™
on
my vba below is copying and pasting data from one sheet to another.
I need assistance in pasting it to the next empty row. I keep getting an error msg when attempting to modify. (the macro below just paste from A2)

Sub Copy()
Dim i As Long
Dim lngLastRow As Long, lngPasteRow As Long

'Find the last row to search through
lngLastRow = Sheets("Data").Range("D65535").End(xlUp).Row

'Initialize the Paste Row
lngPasteRow = 2

For i = 2 To lngLastRow
    If Sheets("Data").Range("D" & i).Value = "test1" Then
        Sheets("Data").Select
        Range("A" & i & ":IV" & i).Copy
        Sheets("Cars").Select
        Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select
        ActiveSheet.Paste
        lngPasteRow = lngPasteRow + 1
    End If
Next i

End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
Please try something like this...

For i = 2 To lngLastRow
    If Sheets("Data").Range("D" & i).Value = "test1" Then
        Sheets("Data").Range("A" & i & ":IV" & i).Copy Sheets("Cars").Range("A" & Rows.Count).End(3)(2)
    End If
Next i

Open in new window



Otherwise instead of looping through the range on Data Sheet, you may use Autofilter to filter the data on column D for the criteria "test1" and copy and paste the filtered rows only.
Also, you should avoid selecting the sheets and ranges unless really required.

Sub Copy()
Dim wsData As Worksheet, wsCars As Worksheet
Dim i As Long
Dim lngLastRow As Long

Application.ScreenUpdating = False

Set wsData = Sheets("Data")
Set wsCars = Sheets("Cars")

'Find the last row to search through
lngLastRow = Sheets("Data").Range("D65535").End(xlUp).Row

With wsData.Rows(1)
    'Autofiltering the column D for the criteria "test1"
    .AutoFilter field:=4, Criteria1:="test1"
    
    'Checking if Autofilter returns any row
    If wsData.Range("A1:A" & lngLastRow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        'Pasting the filtered rows into the Cars sheet in the next empty row
        wsData.Range("A2:IV" & lngLastRow).SpecialCells(xlCellTypeVisible).Copy wsCars.Range("A" & Rows.Count).End(3)(2)
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Open in new window

Gary LensProject Manager

Author

Commented:
wow! that works best. how would I be able to add another criteria using the autofilter option?

Example: I would want to add test2 in the criteria as well.
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
For that, replace the line#16 with the following line...

.AutoFilter Field:=4, Criteria1:="=test1", Operator:=xlOr, Criteria2:="=test2"

Open in new window

Gary LensProject Manager

Author

Commented:
thank you sir!
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome Gary!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial