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
- 3050 reads
Recent comments
5 years 36 weeks ago
6 years 22 weeks ago
6 years 34 weeks ago
6 years 37 weeks ago
6 years 38 weeks ago
6 years 43 weeks ago
6 years 52 weeks ago
7 years 2 days ago
7 years 3 days ago
7 years 3 days ago