Remove Or Delete Rows Having Zero Or Negative Values In A Column

[Admin]

Hi

Try this

Sub moveIMPShipping()

    Dim Area As Range, sr As Long, er As Long
    Dim Sht As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Sht = Worksheets("Sheet1") '<< adjust sheet name
    'adjust the e3 in actual sheet
    For Each Area In Sht.Range("e3", Sht.Range("e" & Sht.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
        With Area
            If Not .Cells(1).Offset(, 4).Value = 0 Then
                sr = .Row
                er = .Rows.Count
                .Cells(er + 1, 1).Value = .Cells(1).Offset(, 3).Value
                .Cells(er + 1, 2).Resize(, 2).Value = .Cells(1).Offset(, 4).Value
                .Cells(er + 1, 2).Resize(, 2).NumberFormat = .Cells(er, 2).Resize(, 2).NumberFormat
            End If
        End With
    Next Area
    
    Sht.Columns.AutoFit
    Application.ScreenUpdating = True

End Sub