MS Excel: Combine all workbooks available under a single folder in to one

We had a requirement of combining all workbooks (Not work sheets) which are available in a folder, into one worksheet.
Condition: Combine only with Sheetname "Updated" from all available Excel workbooks.

As I am not a very good VBA programmer, I could do this in two steps.

Step1
  • Copy below script into a new excel module where all workbook data has to combine
  • Execute script to loop through all excels, select and copy sheetname having "Updated" to current workbook
  • Worksheets will be copied in different worksheets as Updated1, Updated2, Updated3 etc.. under current workbook

Sub GetSheets()
Path = "D:\AllWorkbooksFolder\"
Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
'    For Each Sheet In ActiveWorkbook.Sheets
        Sheets("Updated").Select
            Sheets("Updated").Copy After:=ThisWorkbook.Sheets(1)
'    Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

Step2

Combine all excel worksheets into one by executing another VBA script as below.
Sub CombineSheets()
   Dim ws As Worksheet, wsCombine As Worksheet
   Dim rg As Range
   Dim RowCombine As Integer

   Set wsCombine = ThisWorkbook.Worksheets.Add(ThisWorkbook.Worksheets(1))
   wsCombine.Name = "Combine"

   RowCombine = 1
   For Each ws In ThisWorkbook.Worksheets
      If ws.Index <> 1 Then
         Set rg = ws.Cells(1, 1).CurrentRegion
         rg.Copy wsCombine.Cells(RowCombine, 2)
         wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)).NumberFormat = "@"
         wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)) = ws.Name
         RowCombine = RowCombine + rg.Rows.Count
      End If
   Next
   wsCombine.Cells(1, 1).EntireColumn.AutoFit
   Set rg = Nothing
   Set wsCombine = Nothing
End Sub

No comments:

Post a Comment