Combine Multiple Worksheets Using Excel Vba

Best AnswerVoter's Choice

* PCS_Help answered 5 years ago

You are not stuck. 

- From your spreadsheet, press Alt-F11 to get to the Visual Basic Editor. 

- Select "Insert", "Module". 

- Paste the following code into your module. 

Sub Combine() 

' 

' Developed by PCS_Help 

' For immediate help goto http://www.crossloop.com/PCS_Help 

' 

Dim NumSheets As Integer 

Dim NumRows As Integer 

' Change the value of NumSheets to equal the number of sheets you wish to combine 

NumSheets = 173 

' Change the value of NumRows to equal the number of rows in each sheet 

NumRows = 43 

Worksheets(1).Select 

Sheets.Add 

ActiveSheet.Name = "Consolidated" 

For X = 1 To NumSheets 

Worksheets(X + 1).Select 

Rows("1:" & NumRows).Select 

Selection.Copy 

Worksheets("Consolidated").Select 

ActiveSheet.Paste 

Selection.End(xlDown).Select 

ActiveCell.Offset(1, 0).Select 

Worksheets(X + 1).Select 

Range("A1").Select 

Next X 

Worksheets("Consolidated").Select 

Range("A1").Select 

End Sub 

- Edit the number of sheets and number of rows if required 

- Click on the green play (Run) button 

- Close the Visual Basic Editor 

On the next page is an example of one I (JON WALLACE NOT SOURCE POST) have done and it works! Yay!

Sub Combine()

Dim NumSheets As Integer

Dim NumRows As Integer

' Change the value of NumSheets to equal the number of sheets you wish to combine

NumSheets = 46

' Change the value of NumRows to equal the number of rows in each sheet

NumRows = 6000

Worksheets(1).Select

Sheets.Add

ActiveSheet.Name = "Consolidated"

For X = 1 To NumSheets

Worksheets(X + 1).Select

Rows("1:" & NumRows).Select

Selection.Copy

Worksheets("Consolidated").Select

ActiveSheet.Paste

Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Select

Worksheets(X + 1).Select

Range("A1").Select

Next X

Worksheets("Consolidated").Select

Range("A1").Select

End Sub

OR

Sub GrabData()

'

' GrabData Macro

' Macro recorded 2/12/2009

'...