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
@danwagnerco
Copy link
Author

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
Copy link

hellobm25 commented Jul 29, 2020

@danwagnerco
Copy link
Author

danwagnerco commented Jul 29, 2020

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

@hellobm25
Copy link

hellobm25 commented Jul 29, 2020

@danwagnerco
Copy link
Author

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
Copy link

hellobm25 commented Aug 7, 2020

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment