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
- 3079 reads
Recent comments
5 years 41 weeks ago
6 years 27 weeks ago
6 years 39 weeks ago
6 years 42 weeks ago
6 years 43 weeks ago
6 years 48 weeks ago
7 years 4 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago