Copy Destination Start on 2nd Row-CodePudding

I have this VBA code that copies all rows if a cell in a specific column is not empty to a different worksheet.

Here is my code:

With ws

    For Each Cell In .Range("A2:A" & ws.Cells(.Rows.Count, "A").End(xlUp).Row)

        If Not IsEmpty(ws.Cells(Cell.Row, "P")) Then
            ws.Rows(Cell.Row).Copy Destination:=ws4.Rows(Cell.Row)

        End If
    
    Next Cell

End With

My question is how will I be able to paste it only starting on the 2nd row.

All types of help will be appreciated.

CodePudding user response：

You need a counter for the destination row iRowDest and increase it everytime you pasted a row.

With ws
    Dim iRowDest As Long
    iRowDest = 2  ' start pasting in row 2

    For Each Cell In .Range("A2", ws.Cells(.Rows.Count, "A").End(xlUp))
        If Not IsEmpty(.Cells(Cell.Row, "P")) Then
            .Rows(Cell.Row).Copy Destination:=ws4.Rows(iRowDest)
            iRowDest = iRowDest   1  ' if pasted increase counter for destination row
        End If
    Next Cell
End With

A quicker alternative is to collect all rows you want to copy in a variable using Union and copy them at once. This saves a lot of copy actions and therefore is a lot faster and doesn't need a counter.

With ws
    Dim RowsToCopy As Range

    For Each Cell In .Range("A2", ws.Cells(.Rows.Count, "A").End(xlUp))
        If Not IsEmpty(.Cells(Cell.Row, "P")) Then
            If RowsToCopy Is Nothing Then
                Set RowsToCopy = .Rows(Cell.Row)  ' add first row to variable
            Else
                Set RowsToCopy = Union(RowsToCopy, .Rows(Cell.Row))  ' append all other rows to copy with `Union`
            End If
        End If
    Next Cell
    
    If Not RowsToCopy Is Nothing
        ' copy collected rows and paste them from row 2 onwards
        RowsToCopy.Copy Destination:=ws4.Rows(2)
    Else
        MsgBox "No rows to copy."
    End If
End With

Just a note:

I highly recommend not to number your variable names like ws4. Instead use meaningful names, like wsReport if you generate a report or just wsDestination if it is the destination of your copy/paste action. VBA doesn't care about the name but humans do. So the names of variables should be descriptive and meaningful. This makes it much easier for humans (including yourself) to read your code and therefore leads to less errors. Good naming and coding style helps you a lot to get more productive and find your errors faster (or even run into less errors).

CodePudding user response：

Copy Entire Rows

Sub CopyEntireRows()

    ' For example...
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim ws4 As Worksheet: Set ws4 = ThisWorkbook.Worksheets("Sheet4")

    ' Source
    Dim srg As Range
    Set srg = ws.Range("P2:P" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' Destination
    Dim drrg As Range: Set drrg = ws4.Rows(2)
    
    ' Copy.
    Dim sCell As Range
    For Each sCell In srg.Cells
        If Not IsEmpty(sCell) Then
            sCell.EntireRow.Copy Destination:=drrg
            Set drrg = drrg.Offset(1)
        End If
    Next sCell

End Sub