MS Excel: Combine multiple excel sheets into one sheet with in the workbook

We received an excel file with 70 sheets. It might have generated through some application. One of the requirements was to remove duplicate lines across all sheets. Thus we needed to combine all sheets into one, for further analysis. Fortunately all sheets were in same headers and same format. We had to combine them all into sheet. We accomplished this task with the below script. If you have same requirement follow below steps.
  • Open the excel file which has multiple sheets
  • Press Alt+F11 to open VBA screen
  • Create new module
  • Insert below VBA script inside the module
  • The script will create a new sheet by name "Combine" and copy-paste all sheets into this one sheet
  • Also the script will capture each sheet name and paste the data with respective sheet name

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