Option Explicit | |
Public Sub CombineDataFromAllSheets() | |
Dim wksSrc As Worksheet, wksDst As Worksheet | |
Dim rngSrc As Range, rngDst As Range | |
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long | |
'Notes: "Src" is short for "Source", "Dst" is short for "Destination" | |
'Set references up-front | |
Set wksDst = ThisWorkbook.Worksheets("Import") | |
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)! | |
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)! | |
'Set the initial destination range | |
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1) | |
'Loop through all sheets | |
For Each wksSrc In ThisWorkbook.Worksheets | |
'Make sure we skip the "Import" destination sheet! | |
If wksSrc.Name <> "Import" Then | |
'Identify the last occupied row on this sheet | |
lngSrcLastRow = LastOccupiedRowNum(wksSrc) | |
'Store the source data then copy it to the destination range | |
With wksSrc | |
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol)) | |
rngSrc.Copy Destination:=rngDst | |
End With | |
'Redefine the destination range now that new data has been added | |
lngDstLastRow = LastOccupiedRowNum(wksDst) | |
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1) | |
End If | |
Next wksSrc | |
End Sub | |
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
'INPUT : Sheet, the worksheet we'll search to find the last row | |
'OUTPUT : Long, the last occupied row | |
'SPECIAL CASE: if Sheet is empty, return 1 | |
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long | |
Dim lng As Long | |
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then | |
With Sheet | |
lng = .Cells.Find(What:="*", _ | |
After:=.Range("A1"), _ | |
Lookat:=xlPart, _ | |
LookIn:=xlFormulas, _ | |
SearchOrder:=xlByRows, _ | |
SearchDirection:=xlPrevious, _ | |
MatchCase:=False).Row | |
End With | |
Else | |
lng = 1 | |
End If | |
LastOccupiedRowNum = lng | |
End Function | |
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
'INPUT : Sheet, the worksheet we'll search to find the last column | |
'OUTPUT : Long, the last occupied column | |
'SPECIAL CASE: if Sheet is empty, return 1 | |
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long | |
Dim lng As Long | |
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then | |
With Sheet | |
lng = .Cells.Find(What:="*", _ | |
After:=.Range("A1"), _ | |
Lookat:=xlPart, _ | |
LookIn:=xlFormulas, _ | |
SearchOrder:=xlByColumns, _ | |
SearchDirection:=xlPrevious, _ | |
MatchCase:=False).Column | |
End With | |
Else | |
lng = 1 | |
End If | |
LastOccupiedColNum = lng | |
End Function |
This comment has been minimized.
This comment has been minimized.
missUtoo
commented
Aug 11, 2016
Dear Dan, thanks to sharing this it works like fast train. I have problem bcze I'm totally new on this VBA.. how I can make range or tell that I not want to touch sheets 1-10 and it collect data all other sheet. If you not understand my question, sorry my poor english.. ! Thanks a again you tutorials, these are best so far I find.. you always have some real work that you make in your tutorials that people rally understand that can be use and same time to learn. Brads Markko |
This comment has been minimized.
This comment has been minimized.
badbowler10
commented
Mar 20, 2017
Does this VBA continue to run as more entries are made on the separate sheets or will the macro need to be ran each time? |
This comment has been minimized.
This comment has been minimized.
ayhanakgun7777
commented
Feb 27, 2018
Hello Dan I have a file which has many sheets and I need to combine all sheets in one sheet. I tried to do that by VB but not succeed. Can you please kindly help me for that ? I can send the file to you via e-mail If you share. I will be much appreciated for your help thanks Regards, |
This comment has been minimized.
This comment has been minimized.
ivandgreat
commented
Jan 9, 2019
Hello Dan, Thanks for sharing your code. Anyway, its possible also to add another column for the worksheet name from where it was copied. br, |
This comment has been minimized.
saimhas commentedJul 17, 2016
I Have this code
Sub COPY_DATA()
Dim My_sheet As Worksheet
Dim My_Rg As Range
Dim lr, i, lc, Next_Row, Lr_master, Lc_master As Integer
Next_Row = 2
For i = 1 To Sheets.Count
Set My_sheet = Sheets(i)
If My_sheet.Name <> "Master" Then
With My_sheet
lr = .Cells(Rows.Count, 1).End(3).Row
lc = .Cells(1, Columns.Count).End(1).Column
.Range("a2").Resize(lr - 1, lc).Copy Destination:=Sheets("Master").Cells(Next_Row, 1)
Next_Row = Next_Row + lr - 1
End With
End If
Next
End Sub