XLA routines: EE_CombineSheets

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
»
- Nick's blog
- Login or register to post comments
- 3144 reads
Recent comments
5 years 50 weeks ago
6 years 36 weeks ago
6 years 47 weeks ago
6 years 50 weeks ago
6 years 51 weeks ago
7 years 5 weeks ago
7 years 13 weeks ago
7 years 13 weeks ago
7 years 13 weeks ago
7 years 13 weeks ago