This macro combines data from many sheets into a single sheet

combine_data_from_all_sheets.vb

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

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

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

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?

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,

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,

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 ?

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

Dear Dan, Thank you for the prompt response. Below is the error I encountered. [image: image.png]

…

On Tue, Jul 28, 2020 at 9:18 PM Dan Wagner ***@***.***> wrote: ***@***.**** commented on this gist. ------------------------------ Hey @hellobm25 <https://github.com/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 — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <https://gist.github.com/040402917376969bf362#gistcomment-3395071>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AQNYSDAMUSMY26MNGOBDVPLR53XNLANCNFSM4PKTPLGQ> .

-- Thanks, M.Bhargavi

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

Dear Dan, Sorry for the trouble. Here is the error message. Excel cannot open the file because the file format or file extension is not valid. Verify that the file has not been corrupted and that the file extension matches the format of the file. This is the error message. The file is basically empty. The extension and format are correct.

…

On Wed., 29 Jul. 2020, 5:28 pm Dan Wagner, ***@***.***> wrote: ***@***.**** commented on this gist. ------------------------------ Hey @hellobm25 <https://github.com/hellobm25> -- the image is not showing, can you write in the error? Thanks! -Dan — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <https://gist.github.com/040402917376969bf362#gistcomment-3396462>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AQNYSDB2BLW5XVAUNUKY6ILR6AFG7ANCNFSM4PKTPLGQ> .

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

Dear Dan, Thanks for the reply!! I tried with the Error handler as suggested but my problem still persists. For test purpose, i created a folder on desktop and kept 5 files inside the folder. File 1 and File 3 is corrupted. I executed the below code and after execution i see that instead of having 3 sheets(as only 3 is error less out of 5) i saw the program created 8 sheets. meaning, it has processed file 1 since it is corrupted moved to the second file copied it moved to the third file since that is corrupted, it again resumed execution from first so i saw second file copied twice and for each file it copied it has opened a new sheet. Dont know what mistake i'm doing. But cannot fix it. Please help! Sub GetSheets() path = "MY FILE PATH\" On Error GoTo errHandler1 fileName = Dir(path & "*.*") Do While fileName <> "" Workbooks.Open fileName:=path & fileName, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(fileName).Close fileName = Dir() Loop Exit Sub errHandler1: Debug.Print Err.Number & ": " & Err.Description Resume Next End Sub

…

On Fri, Jul 31, 2020 at 6:10 PM Dan Wagner ***@***.***> wrote: ***@***.**** commented on this gist. ------------------------------ Hey @hellobm25 <https://github.com/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 — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <https://gist.github.com/040402917376969bf362#gistcomment-3399363>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AQNYSDFR4R7QHJGD3ETSFODR6K3S3ANCNFSM4PKTPLGQ> .

-- Thanks, M.Bhargavi