See the attached file.
Dim wsTest As Worksheet
'check if sheet "Consolidated" already exist
Const strSheetName As String = "Consolidated"
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
End If
With Sheets("Consolidated")
.UsedRange.ClearContents
.Range("A1:P1").Value = Array("sheet", "", "", "", "", "", "", "", "etc")
For Each Sh In Sheets
With Sh
If .Name <> "Consolidated" And .Name <> "Summary" And .Name <> "Output" And .Name <> "PivotTable" Then
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
If lr >= 2 Then
Rng = .Cells.Find("*", , , , xlByRows, xlPrevious).Row - 1
NR = Sheets("Consolidated").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Rng > 0 Then
Sheets("Consolidated").Cells(NR, 1).Resize(Rng) = .Name
Sheets("Consolidated").Cells(NR, 2).Resize(Rng, 16) = .Range("A2").Resize(Rng, 16).Value
End If
End If
End If
End With
Next
On Error Resume Next
.Columns("A:Z").EntireColumn.AutoFit
End With
End Sub
Bookmarks