consolidate multiple worksheets into one worksheet - excel

Question

I want to consolidate multiple worksheets into one worksheet in the same excel, but i don't want some data after a specific word "Total" in all the worksheets. What should i do to delete the data after the word "Total" and then consolidate all the sheets.
Below code is written to add multiple worksheets.
Sub Consolidate()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim erow As Long, lrowsh As Long, startrow As Long
Dim CopyRng As Range
startrow = 3
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Deleting "Consolidate" sheet
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Consolidate").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Adding worksheet with the name "Consolidate"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Consolidate"
'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
'Find the next blank or empty row on the DestSh
erow = DestSh.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
'Find the last row with data in the Sheet
lrowsh = sh.Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = sh.Range(sh.Rows(startrow), sh.Rows(lrowsh))
'copies Values / formats
CopyRng.Copy
With DestSh.Cells(erow, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
End Sub

Answer 1

Interesting Workbook Consolidation
Change the constants (Const) to fit your needs.
The Code
Sub Consolidate()
' Target
Const cTarget As String = "Consolidate" ' Target Worksheet Name
' Source
Const cFR As Long = 3 ' First Row Number
Const cLRC As Variant = 1 ' Last-Row Column Letter/Column Number
Const cCrit As String = "Total" ' Criteria
Dim wb As Workbook ' Target Workbook
Dim wsT As Worksheet ' Target Worksheet
Dim ws As Worksheet ' Current Source Worksheet
Dim eRow As Long ' Target First Empty Row
Dim lRow As Long ' Source Last Used Row
Dim lCol As Long ' Source Last Used Column
Dim rngCell As Range ' Cell Ranges
Dim rng As Range ' Ranges
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Create a reference to Target Workbook. If the code will NOT be in the
' workbook to be processed, then use its name (preferable) or
' ActiveWorkbook instead of ThisWorkbook.
Set wb = ThisWorkbook
' Note: Instead of the following with block you could use code to clear
' or clear the contents of the Target Worksheet.
With wb
'Delete Target Worksheet.
Application.DisplayAlerts = False
On Error Resume Next
.Worksheets("Consolidate").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add Target Worksheet.
Set wsT = .Worksheets.Add(Before:=.Sheets(1)) ' First Tab
wsT.Name = "Consolidate"
End With
' Handle errors.
On Error GoTo ErrorHandler
' Loop through all worksheets.
For Each ws In wb.Worksheets
If ws.Name <> wsT.Name Then
With ws.Cells(cFR, cLRC).Resize(ws.Rows.Count - cFR + 1, _
ws.Columns.Count - cLRC + 1)
' Note: Choose only one of the following two lines.
'Find the first occurrence of Criteria in Current Worksheet.
Set rngCell = .Find(cCrit, .Cells(.Rows.Count, .Columns _
.Count), xlValues, xlWhole, xlByRows, xlNext)
' 'Find the last occurrence of Criteria in Current Worksheet.
' Set rng = .Find(cCrit, , xlValues, xlWhole, xlByRows, _
' xlPrevious)
' Clear the range below the row where Criteria was found.
ws.Rows(rngCell.Row + 1 & ":" & ws.Rows.Count).Clear
' Create a reference to Row Range (of Copy Range).
Set rng = .Cells(1).Resize(rngCell.Row - cFR + 1, _
.Columns.Count - cLRC + 1)
End With
' Create a reference to last cell in last column of Row
' Range (of Copy Range).
Set rngCell = rng.Find("*", , xlFormulas, , _
xlByColumns, xlPrevious)
' Create a reference to Copy Range.
Set rng = rng.Cells(1).Resize(rng.Rows.Count, _
rngCell.Column - cLRC + 1)
'Find the next blank or empty row in Target Worksheet.
eRow = wsT.Cells(wsT.Rows.Count, cLRC).End(xlUp) _
.Offset(1, 0).Row
' Copy Copy Range.
rng.Copy
' In (First Empty Row of) Target Worksheet
With wsT.Cells(eRow, 1)
' First paste the formats to avoid trouble mostly when pasting
' dates or time. Excel might firstly format it differently, and
' when pasting the formats might not revert to desired formats.
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End If
Next
' Go to the top of Target Worksheet.
ActiveSheet.Range("A1").Select
' Inform user of success (Since the code is fast, you might not know if it
' had run at all).
MsgBox "The operation finished successfully.", vbInformation, "Success"
ProcedureExit:
' Speed down.
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ErrorHandler:
MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
& Err.Description, vbCritical, "Error"
GoTo ProcedureExit
End Sub