XLA routines: EE_CombineSheets

Nick's picture
EE_CombineSheets is a routine that combines the sheets on a workbook - works if the headers are the same
Sub EE_CombineSheets(wbkFrom As Workbook, rngTarget As range, Optional arrSheetNames As Variant)
    Dim intSheets       As Integer
    Dim rngCopy         As range
    Dim rngPaste        As range
    Dim wks             As Worksheet
    Dim wksNew          As Worksheet
    Dim x               As Integer
 
'http://excelexperts.com/xla-routines-eeCombineSheets    for updates on this sub routine
    If IsArray(arrSheetNames) = False Then
        ReDim arrSheetNames(1 To ThisWorkbook.Worksheets.Count)
        For x = LBound(arrSheetNames) To (UBound(arrSheetNames))
            arrSheetNames(x) = wbkFrom.Worksheets(x).Name
        Next x
        Set wksNew = wbkFrom.Worksheets.Add(after:=wbkFrom.Worksheets(wbkFrom.Worksheets.Count))
        Set rngTarget = wksNew.range("A1")
    End If
 
    For intSheets = LBound(arrSheetNames) To UBound(arrSheetNames)
        On Error Resume Next
            Set wks = wbkFrom.Worksheets(CStr(arrSheetNames(intSheets)))
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        If wks Is Nothing Then GoTo NextSheet
 
        If intSheets = LBound(arrSheetNames) Then
            Set rngCopy = wks.UsedRange
            Set rngPaste = rngTarget
        Else
            Set rngPaste = rngPaste.Offset(rngCopy.Rows.Count)
            With wks
                Set rngCopy = Intersect(.UsedRange, .UsedRange.Offset(1))
            End With
        End If
        rngCopy.Copy
        rngPaste.PasteSpecial xlPasteValues
        rngPaste.PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
NextSheet:
    Next intSheets
 
    Set rngCopy = Nothing
    Set rngPaste = Nothing
    Set wksNew = Nothing
    Set wks = Nothing
End Sub