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

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