Correct consolidated data from mulltiple worksheets into a worksheet of a same workbook.

Sub consolidateSheets()
Dim shtDone As Worksheet, lstRow As Long
Dim wksht As Worksheet, firstSheet As Boolean

Const bolTitles As Boolean = True 'True if sheets have titles, false if they don't
Const strSummary As String = "All" ' update to the name of the consolidated destination
Const bolTab As Boolean = f 'get data from tab name ? True / False
Const strTabTitle As String = "Type" 'title of column from tab name if bolTab=true
Dim lgTabCol As Long

'Call TurnOffAllUpdates(True)

Set shtDone = Sheets.Add

On Error Resume Next
shtDone.Name = strSummary

If Err.Number <> 0 Then
    ActiveWorkbook.Sheets(strSummary).Delete
    shtDone.Name = strSummary
    Err.Clear
End If
Application.ScreenUpdating = False
firstSheet = True

For Each wksht In ActiveWorkbook.Sheets
    
    If wksht.Name = strSummary Or Not wksht.Visible = xlSheetVisible Then GoTo nxtSht
    
    lstRow = shtDone.Range("A" & Rows.Count).End(xlUp).Row
    
    wksht.[a152].CurrentRegion.Resize(wksht.Cells(Rows.Count, 1).End(xlUp).Row - 150).Copy _
            shtDone.Cells(lstRow + 1, 1)

    If bolTitles = True And firstSheet = False Then
        Rows(lstRow + 1).Delete
        Rows(lstRow + 1).Delete 'MERGED TITLE ROW
    Else
        If bolTab = True And firstSheet = True Then
            lgTabCol = shtDone.UsedRange.Columns.Count + 1
            shtDone.Cells(2, lgTabCol) = strTabTitle
            lstRow = lstRow + 1
        End If
    End If
    
    If bolTab = True Then
        shtDone.Cells(lstRow + 1, lgTabCol) = wksht.Name
    End If
        
    firstSheet = False

nxtSht:
Next

If bolTab = True Then
    Intersect(ActiveSheet.UsedRange, Columns(lgTabCol)).Offset(1, 0).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    Columns(lgTabCol).Copy
    ActiveSheet.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If

shtDone.Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True
End Sub

Select allOpen in new window