Excel VBA remove blank rows from specific range - excel

Question

I have an excel macro that creates a new sheet called "Compiled", copies over the contents of every sheet in the workbook from A2 onward (so the header isn't copied). This works great, except I often get tons of completely blank rows all over the place.
My objective is to have a macro to find the last row in the Compiled sheet, and delete any fully blank rows.
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

If I am not wrong, you want to combine data from different worksheets into one master sheet. But your code is producing lots of empty rows in the "Compiled" sheet. That's why you want to "remove blank rows from specific range".
What I understand from your code:
you want to:
delete sheets named "Instructions" and "TM Contacts"
add a new sheet "Compiled"
copy header from the table "Table_1" in sheet "<Last Name, First Name>" and paste it as header for sheet "Compiled"
copy data "A2" to "AB & last row" from all sheets to sheet "Compiled", starting from "A2"
Please check if this works:
Here 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