If you delete everything that is not blank then you get a blank sheet. why
not just clear the enire sheet????? The code below does the copying not the
delete.
Sub PackRows()
Set SourceSht = Sheets("Sheet1")
Set DestSht = Sheets("Sheet2")
NewRowCount = 1
With SourceSht
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For OldRowCount = 1 To LastRow
LastCol = .Cells(OldRowCount, Columns.Count). _
End(xlToLeft).Column
If (LastCol > 1) Or .Cells(OldRowCount, "A") <> "" Then
.Rows(OldRowCount).Copy _
Destination:=DestSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
Next OldRowCount
End With
End Sub
Sub PackRows()
Set SourceSht = Sheets("Sheet1")
Set DestSht = Sheets("Sheet2")
NewRowCount = 1
With SourceSht
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For OldRowCount = 1 To LastRow
LastCol = .Cells(OldRowCount, Columns.Count). _
End(xlToLeft).Column
If (LastCol > 1) Or .Cells(OldRowCount, "A") <> "" Then
.Rows(OldRowCount).Copy _
Destination:=DestSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
Next OldRowCount
End With
End Sub