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

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