Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
This macro combines data from many sheets into a single sheet
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
@saimhas

This comment has been minimized.

Copy link

@saimhas saimhas commented Jul 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

With Sheets("master")
    Lr_master = .Cells(Rows.Count, 1).End(3).Row
    Lc_master = .Cells(1, Columns.Count).End(1).Column
    .Range("a2").Resize(Lr_master, Lc_master).ClearContents
End With

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

@missUtoo

This comment has been minimized.

Copy link

@missUtoo 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.
I have all PO's on right side more then 300 and left side after my "MSTR" which is same as you have import. so it only collect same data all PO's which i use for make Pivot tables as client want.
Your code is so fast and I like to use this one rater what I use now.. I have make copy paste my code 3 part and it work but I have problem... all PO's that I change later.. I can't add or delete any row and whiteout going MSTR to delete or add row manually.. So I test you code this way that each time I import first I delete all and then import all data again.. and this way it keep all up to date if I add or delete come row in my PO's... But my problem is now how I can tell this code... that I want only range of pages or not touch range of sheets when it collect data.

If you not understand my question, sorry my poor english.. !
I can then send you email my PO's and master sheet for look my problem.

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

@badbowler10

This comment has been minimized.

Copy link

@badbowler10 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?

@ayhanakgun7777

This comment has been minimized.

Copy link

@ayhanakgun7777 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,

@ivandgreat

This comment has been minimized.

Copy link

@ivandgreat 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,

@hellobm25

This comment has been minimized.

Copy link

@hellobm25 hellobm25 commented Jul 28, 2020

Hi, Thanks for the code. I have about 64 files (each having around 25000 line data). This code helped me in combining the files. But, if one of the 64 file is corrupted the code is interrupted and stops execution. Could you help me in fixing this? All i want is can this code be modified such that in case it encounters a erroneous files, it skip the file and continue to combine the other files and at end send a message or report about which files was skipped ?

@danwagnerco

This comment has been minimized.

Copy link
Owner Author

@danwagnerco danwagnerco commented Jul 28, 2020

Hey @hellobm25 -- I think you can address this by catching the error that occurs when a corrupted file is opened (or attempted to be opened).

The "On Error" write-up here is great: https://excelmacromastery.com/vba-error-handling/

What is the error?

Thanks! -Dan

@hellobm25

This comment has been minimized.

Copy link

@hellobm25 hellobm25 commented Jul 29, 2020

@danwagnerco

This comment has been minimized.

Copy link
Owner Author

@danwagnerco danwagnerco commented Jul 29, 2020

Hey @hellobm25 -- the image is not showing, can you write in the error? Thanks! -Dan

@hellobm25

This comment has been minimized.

Copy link

@hellobm25 hellobm25 commented Jul 29, 2020

@danwagnerco

This comment has been minimized.

Copy link
Owner Author

@danwagnerco danwagnerco commented Jul 31, 2020

Hey @hellobm25 -- OK cool, in order to address this you should wrap your loop in an "OnError" handler like Chip Pearson describes:

http://www.cpearson.com/excel/ErrorHandling.htm

^-- inside the ErrorHandler: piece, you can store the file name inside a collection then dump all those filenames to a MsgBox at the end of the script so you know which ones failed.

From Chip's examples:

On Error GoTo ErrHandler:
    N = 1 / 0
    Debug.Print N
    Exit Sub

    ErrHandler:
    N = 1
    ' go back to the line following the error
    Resume Next

Thanks! -Dan

@hellobm25

This comment has been minimized.

Copy link

@hellobm25 hellobm25 commented Aug 7, 2020

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.