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

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:

Code:

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:

Code:

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.