Copy a sheet from multiple workbooks within a folder

slparadise

New Member
Joined
Jan 30, 2015
Messages
16
I have about 500 workbooks that I need to analyze for trends. I need to copy "Sheet 2" from every workbook into a new workbook. Here are the steps in my mind (feel free to correct)...

Step 1: Open workbook "NEW"
Step 2: Open workbook "A" - copy sheet 2 from workbook "A" and paste into workbook "NEW" sheet 1 - Create sheet "2" in workbook "NEW" - close workbook "A"
Step 3: Open workbook "B" - copy sheet 2 from workbook "B" and paste into workbook "NEW" sheet 2 - Create sheet "3" in workbook "NEW" - close workbook "B"
Step 4: Open workbook "C" - copy sheet 2 from workbook "C" and paste into workbook "NEW" sheet 3 - Create sheet "4" in workbook "NEW" - close workbook "C"

Repeat steps until all of the sheet 2 form all of workbooks in the folder have been copied into the "NEW" workbook. I know the limit on sheets in a workbook is about 250 so I would need to use multiple workbooks to assimilate all of the data.

Any and all help is appreciated.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,032
I need to copy "Sheet 2" from every workbook into a new workbook
Try this macro, changing the path and file spec of the input workbooks and the path and file name format of the output workbooks as required.
VBA Code:
Public Sub Copy_Sheet_From_All_Workbooks_In_Folder2()

    Dim matchWorkbooks As String, newWorkbookNameTemplate As String
    Dim folderPath As String, fileName As String
    Dim newWorkbook As Workbook, copyFromWorkbook As Workbook
    Dim newWorkbookCount As Long
    Const MAX_SHEETS_PER_WORKBOOK = 250
   
    matchWorkbooks = "C:\folder\path\*.xlsx"                                        'path and wildcard file spec of input workbooks
    newWorkbookNameTemplate = ThisWorkbook.Path & "\New workbook <count>.xlsx"      'path and file name format of output workbooks
   
    Application.ScreenUpdating = False
   
    Set newWorkbook = Nothing
    newWorkbookCount = 0
   
    folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    fileName = Dir(matchWorkbooks)
   
    While fileName <> vbNullString
   
        If Not newWorkbook Is Nothing Then
            If newWorkbook.Worksheets.Count - 1 = MAX_SHEETS_PER_WORKBOOK Then
                Application.DisplayAlerts = False
                newWorkbook.Worksheets(1).Delete
                newWorkbook.Close SaveChanges:=True, fileName:=Replace(newWorkbookNameTemplate, "<count>", newWorkbookCount)
                Application.DisplayAlerts = True
                Set newWorkbook = Nothing
            End If
        End If
       
        If newWorkbook Is Nothing Then
            Set newWorkbook = Workbooks.Add(xlWBATWorksheet)
            newWorkbook.Worksheets(1).Name = "_TEMP_"
            newWorkbookCount = newWorkbookCount + 1
        End If
       
        Set copyFromWorkbook = Workbooks.Open(folderPath & fileName)
        copyFromWorkbook.Worksheets("Sheet 2").Copy After:=newWorkbook.Worksheets(newWorkbook.Worksheets.Count)
        copyFromWorkbook.Close SaveChanges:=False
       
        fileName = Dir
        DoEvents
       
    Wend
   
    If Not newWorkbook Is Nothing Then
        Application.DisplayAlerts = False
        newWorkbook.Worksheets(1).Delete
        newWorkbook.Close SaveChanges:=True, fileName:=Replace(newWorkbookNameTemplate, "<count>", newWorkbookCount)
        Application.DisplayAlerts = True
    End If
   
    Application.ScreenUpdating = True
   
    MsgBox "Done"
   
End Sub
 

Forum statistics

Threads
1,143,673
Messages
5,720,223
Members
422,270
Latest member
CaptainMurray

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top