This code copies columns P & Q from each worksheet and posts them to a new worksheet consolidated. It also deletes all blank cells.
The code works on a very small file but isn't producing the same results on the new workbook.
ALL COLUMNS from previous "small workbook" to new workbook are the same. The only thing that changed is the number of worksheets which is 650.
I get a runtime error 429 "Activex component can't create object".
Sub merge()
Dim Sh As Worksheet, ShM As Worksheet, i&, z&
Application.ScreenUpdating = 0
Set Sh = Worksheets.Add(, Sheets(Sheets.Count))
Sh.Name = "consolidated"
For Each ShM In ThisWorkbook.Worksheets
If ShM.Name <> Sh.Name Then
i = ShM.Cells(Rows.Count, 17).End(xlUp).Row
z = Sh.Cells(Rows.Count, 2).End(xlUp).Row + 1
While (z > 1) And (Sh.Cells(z, 2).Value = "")
z = z - 1
Wend
ShM.Activate: ShM.Range(Cells(1, 16), Cells(i, 17)).Copy
Sh.Activate: Sh.Cells(z, 1).PasteSpecial xlPasteValues
End If
Next ShM
Application.ScreenUpdating = 1
End Sub