OzGrid

How to use VBA code to copy rows from one sheet to another excluding "empty" rows

Requirement:

The user has a sheet in excel (called Fedex) that is auto populated from a different sheet (invoice). The user would like to copy entire rows from the fedex sheet that have a nonzero value in column A, such that in the new sheet the user has a simple table of all items that have nonzero quantities. The user has a module that is currently just copying the entire list into a new sheet, 0 rows included.

This is what the user currently has:

Sub cpynpst()
Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range
Set sh4 = Sheets("Fedex")
Set sh5 = Sheets("Sheet2")
For Each rng In sh4("A2:A")
If rng.Value <> 0 Then
lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("A2:A" & lr)
rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next rng
End Sub

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1199725-copying-rows-from-one-sheet-to-another-excluding-empty-rows

Solution:

Sub CopyData()
    Dim x, y(), i As Long, ii As Long, iii As Long
    
    x = Sheets("COPY FROM").Cells(1).CurrentRegion
    For i = 1 To UBound(x, 1)
        If x(i, 1) <> 0 Then
            iii = iii + 1: ReDim Preserve y(1 To UBound(x, 2), 1 To iii)
            For ii = 1 To UBound(x, 2)
                y(ii, iii) = x(i, ii)
            Next
        End If
    Next
    With Sheets("FINAL")
        .Cells.Clear
        .[a1].Resize(iii, UBound(y, 1)) = Application.Transpose(y)
    End With

End Sub

Obtained from the OzGrid Help Forum.

Solution provided by KjBox.

See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets

See also:

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.

Gallery