Excel VBA remove blank rows from specific range

Question

I have an excel macro that generates a new sheet called "Compiled," duplicates over every page's contents starting with A2 (the header is not duplicated), and creates the new sheet. This works excellently, but I frequently end up with a tonne of rows that are entirely blank.

My goal is to create a macro that will locate the last row in the compiled sheet and remove any rows that are entirely blank.

Here's my current script:

Sub CombineData()

' Delete unneeded sheets

    Application.DisplayAlerts = False
    Sheets("Instructions").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("TM Contacts").Select
    ActiveWindow.SelectedSheets.Delete
    
' Add new sheet called Compiled

    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Compiled"
    Sheets("Lastname, First Name").Select
    Range("Table_1[#Headers]").Select
    Selection.Copy
    Sheets("Compiled").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A2").Select
    
' Copy all sheet contents onto one

Dim lastRowSource As Long, lastRowDest As Long, i As Long
For i = 1 To Sheets.Count
    If Not Sheets(i).Name = "Compiled" Then
        lastRowSource = Sheets(i).Cells(Sheets(i).Rows.Count, "A").End(xlUp).Row
        lastRowDest = Sheets("Compiled").Cells(Sheets("Compiled").Rows.Count, "A").End(xlUp).Row
        With Sheets(i)
            .Range(.Cells(2, "A"), .Cells(lastRowSource, "AB")).Copy Sheets("Compiled").Range(Sheets("Compiled").Cells(lastRowDest + 1, "A"), Sheets("Compiled").Cells(lastRowDest + 1 + lastRowSource, "AB"))
        End With
    End If
 Next i
 
 ' delete blank rows

 End Sub

I tried this code from an older question to delete the blank rows, which gave me an "out of range" error:

Dim myWs As Worksheet
Set myWs = ThisWorkbook.Worksheets("Compiled") 'set your sheet name
Dim lastRow As Long
lastRow = myWs.Range("A" & myWs.Rows.Count).End(xlUp).Row 'find last used row

With myWs.Range(myWs.Cells(2, "A"), myWs.Cells(lastRow, "A"))
    .Value = .Value  'convert formulas to values whithin the range from with block (column A only)
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'delete rows where column A is blank
End With

The error with this code appears to be at "Dim myWs As Worksheet". This is where I get the "out of range" error. I'm trying to point to the compiled worksheet.

Answer 1

I have tried to avoid .select 

Option Explicit

Sub CombineData()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim lastRowDest As Long
    Dim lastRowSource As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'delete sheets named "Instructions" and "TM Contacts". also delete "Compiled", if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Instructions").Delete
    ActiveWorkbook.Worksheets("TM Contacts").Delete
    ActiveWorkbook.Worksheets("Compiled").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'add a new sheet "Compiled"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Compiled"
    
    'copy header from the table "Table_1" in sheet "Last Name, First name" and paste it as header for sheet "Compiled"
    'from your code I assume you have a data formatted as a table, "Table_1"
    ActiveWorkbook.Worksheets("Last Name, First Name").ListObjects("Table_1").HeaderRowRange.Copy
    DestSh.Range("A1").PasteSpecial xlPasteValues
        

    'copy data "A2" to "AB & last row" from all sheets to sheet "Compiled",starting from "A2"
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            With DestSh
                lastRowDest = .Range("A" & .Rows.Count).End(xlUp).Row
            End With
            
            With sh
                lastRowSource = .Range("A" & .Rows.Count).End(xlUp).Row
            End With

            'if you want to change copy range, change here
            Set CopyRng = sh.Range("A2:AB" & lastRowSource)

            With CopyRng
                DestSh.Cells(lastRowDest + 1, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub