VBA, Copy rows from multple Worksheets to a master sheet - vba

Question

I have a macro that does a calculation for all sheets in a workbook, I need to copy these results(which are located in the last row of each sheet, but each row may be different for each sheet) to a master sheet(as it needs to be done for multiple files), could anyone help alter my macro to do this or even make a new one?
If needed here is my macro:
Sub Calculationallsheetsv2()
'Calculation all sheets, even when there is only headers
Dim xrng As Range, lrw As Long, lrng As Range, i As Long
Dim LstCo As Long, ws As Worksheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each ws In ActiveWorkbook.Worksheets
With ws
If Not Application.WorksheetFunction.CountA(.Cells) = 0 Then
LstCo = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
For i = 1 To LstCo
With .Columns(i)
.TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, TrailingMinusNumbers:=True
End With
Next
lrw = .Columns("A:Y").Find("*", , xlValues, , xlRows, xlPrevious).row
If lrw = 1 Then lrw = 2
Set lrng = .Range("A" & lrw + 2)
With .Range("A2:A" & lrw)
lrng.Formula = "=COUNTA(" & .Address(0, 0) & ")/ROWS(" & .Address(0, 0) & ")"
End With
Set xrng = .Range(lrng, .Cells(lrng.row, LstCo))
lrng.AutoFill xrng, Type:=xlFillDefault
xrng.Style = "Percent"
End If
End With
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
Application.CalculateFull
End With
End Sub

Answer 1

Below is the code to accomplish the task you have described. I put some comment, so you can understand what is going on. If you have any further questions regarding this code, ask in comment.
NOTE. There is one external function used in the code below so you need to include it in your code as well, otherwise it will not compile. Here is the code of this function - Function to find the last non-empty row in a given worksheet.
Sub Calculationallsheetsv2()
'Calculation all sheets, even when there is only headers
Const SUMMARY_SHEET_NAME As String = "Summary"
'-----------------------------------------
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
Dim arrRow As Variant
Dim lastRow As Long
'-----------------------------------------
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wkb = Excel.ActiveWorkbook
'Create [Summary] worksheet. -----------------------------------------------------
On Error Resume Next
Set wksSummary = wkb.Worksheets(SUMMARY_SHEET_NAME)
On Error GoTo 0
If wksSummary Is Nothing Then
Set wksSummary = wkb.Worksheets.Add
wksSummary.Name = SUMMARY_SHEET_NAME
End If
'---------------------------------------------------------------------------------
'Iterate through all the worksheets in the workbook [wkb].
For Each wks In wkb.Worksheets
'Check the name of currently checked worksheet to exclude [Summary] worksheet
'from this process.
If wks.Name <> SUMMARY_SHEET_NAME Then
'Check if there are any non-empty cells in this worksheet.
If Application.WorksheetFunction.CountA(wks.Cells) Then
'Find the index number of the last empty row.
lastRow = lastNonEmptyRow(wks)
'Copy the content of this row into array.
arrRow = wks.Rows(lastRow).EntireRow
'Paste the content of [arrRow] array into the first empty
'row of the [Summary] worksheet.
With wksSummary
.Rows(lastNonEmptyRow(wksSummary) + 1).EntireRow = arrRow
End With
End If
End If
Next wks
'Restore screen updating and automatic calculation
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
Call .CalculateFull
End With
End Sub
EDIT
If you want to put the result into a new workbook instead of a new worksheet within the same workbook you need to replace this block of code:
'Create [Summary] worksheet. -----------------------------------------------------
On Error Resume Next
Set wksSummary = wkb.Worksheets(SUMMARY_SHEET_NAME)
On Error GoTo 0
If wksSummary Is Nothing Then
Set wksSummary = wkb.Worksheets.Add
wksSummary.Name = SUMMARY_SHEET_NAME
End If
'---------------------------------------------------------------------------------
with this one:
'Create [Summary] worksheet. -----------------------------------------------------
Dim wkbSummary As Excel.Workbook
Set wkbSummary = Excel.Workbooks.Add
Set wksSummary = wkbSummary.Worksheets.Add
wksSummary.Name = SUMMARY_SHEET_NAME
'---------------------------------------------------------------------------------