VBA create results sheet

[tsitsicat1]

Good morning to all!
I have a weekly report from our erp system that shows aging analysis of our sales that contains 16 sheets with rows that aren't the same ever time.
I would like the final row of every sheet to be copy in another sheet in order to create a table that shows the results of all the sheets in one.
Can anyone help me with this?
I spend over 2 hours per week in order to manage this.
Pleaseeee...

 

[ranman256]

Sub CopyAll()
Dim sht As Worksheet, shtTarg As Worksheet
Dim r As Long

Sheets(1).Activate
Sheets.Add
Set shtTarg = ActiveSheet
shtTarg.Name = "Total"

Sheets(2).Activate
Rows("1:1").Copy
shtTarg.Activate
Range("A1").Select
ActiveSheet.Paste

For Each sht In Sheets
   If sht.Name <> "Total" Then
      sht.Activate
      Range("A1").Select
      GotoBtm
      r = ActiveCell.Row
      Rows(r & ":" & r).Copy
      shtTarg.Activate
      GotoBtm
      ActiveSheet.Paste
      NextRow
   End If
Next
Set sht = Nothing
Set shtTarg = Nothing
End Sub

Private Sub GotoBtm()
Select Case True
   Case ActiveCell.Value = ""
   Case ActiveCell.Offset(1, 0).Value = ""
       ActiveCell.Offset(1, 0).Select
   Case Else
       Selection.End(xlDown).Select
End Select
End Sub

Private Sub NextRow()
ActiveCell.Offset(1, 0).Select
End Sub

 

[mse330]

This is just another approach ...

Sub ConsolidateTotals()
Dim ws As Worksheet, Rg As Range, lRow As Long, lCol As Long, Arr() As String, Cnt As Long
ReDim Arr(1 To Sheets.Count)
Set ws = Sheets.add(after:=Sheets(Sheets.Count))
ws.Name = "Totals Sheet"
For Each ws In Worksheets
    If ws.Name <> "Totals Sheet" Then
        lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        lCol = ws.Cells(lRow, Columns.Count).End(xlToLeft).Column
        Set Rg = ws.Range(ws.Cells(lRow, 1), ws.Cells(lRow, lCol))
        Cnt = Cnt + 1
        Arr(Cnt) = ws.Name
        With Sheets("Totals Sheet")
            lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & lRow).Resize(, lCol) = Rg.Value
        End With
    End If
Next
With Sheets("Totals Sheet")
    .Columns(1).EntireColumn.Insert
    .Range("A2").Resize(UBound(Arr)).Value = Application.Transpose(Arr)
End With
End Sub