If data in any cell of the row, copy to the sheet2

This will delete all the blank rows:

Sub DeleteEmptyRows()
Dim LastRow As Integer
Dim MyRow As Integer
Application.ScreenUpdating = False
   LastRow = ActiveSheet.UsedRange.Row - 1 + _
        ActiveSheet.UsedRange.Rows.Count
 For MyRow = LastRow To 1 Step -1
        If Application.CountA(Rows(MyRow)) = 0 Then Rows(MyRow).Delete
    Next MyRow
Application.ScreenUpdating = True
End Sub

Dom