Combine multiple SHEETS from a Workbook.

Last Row/Column - [ Ссылка ]

Code:
Sub Consolidate()

Dim LR, LC As Long
Dim sht As Worksheet
Dim wrk As Workbook

Set wrk = ActiveWorkbook

For Each sht In wrk.Worksheets
If sht.Name "Master" Then
sht.Select
LR = ActiveSheet.Range("A100000").End(xlUp).Row
LC = ActiveSheet.Range("XFD1").End(xlToLeft).Column
ActiveSheet.Range(Cells(2, 1), Cells(LR, LC)).Copy
Sheets("Master").Select
LR_M = ActiveSheet.Range("A100000").End(xlUp).Row + 1

Sheets("Master").Range("A" & LR_M).PasteSpecial (xlPasteValues)
End If

Next
End Sub

свернуть