Need to delete blank rows from various worksheets in same workbook-reg

Question

Hi Team,
I am searching for a macro to delete the blank rows from my worksheets.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long, Worksheet As Object
Application.ScreenUpdating = False
endRow = 1000
pasteRowIndex = 1
For r = 1 To endRow
    If Cells(r, Columns("A").Column).Value = "12345" Then
            Rows(r).Select
            Selection.Copy
            Sheets("12345").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste
            CutCopyMode = False
            pasteRowIndex = pasteRowIndex + 1
            Sheets("NORMAL").Select
End If
    If Cells(r, Columns("A").Column).Value = "45678" Then
            Rows(r).Select
            Selection.Copy
            Sheets("45678").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste
            pasteRowIndex = pasteRowIndex + 1
            Sheets("NORMAL").Select
    End If
    If Cells(r, Columns("A").Column).Value = "36925" Then
            Rows(r).Select
            Selection.Copy
            Sheets("36925").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste
            pasteRowIndex = pasteRowIndex + 1
            Sheets("NORMAL").Select
    End If
     If Cells(r, Columns("A").Column).Value = "789456" Then
            Rows(r).Select
            Selection.Copy
            Sheets("789456").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste
            pasteRowIndex = pasteRowIndex + 1
            Sheets("NORMAL").Select
next r
end sub()
the above code searches for the value "12345" "45678" "36925" "789456" if found in worksheet (normal) then it picks the value and paste it in new corresponding worksheet with sheet number (12345). while pasting like
this it has some blank rows so it need to delete the rows help me out of this problem. thanks in advance

Answer 1

Hi vigneshvicky,
This code snippet works fine to delete the blank rows, please try it:
ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
Click
HERE to participate the survey.