Copy A Worksheet in Directory & Subdirectory

termeric

Active Member
Joined
Jun 21, 2005
Messages
257
Hello, i've been using this code for a while to open all the excel files in a directory and copy a worksheet so that i can aggregate information into a single space. I'd like to modify this to look in directories and subdirectories. is there an easy way to do that with out starting over from scrathc?

Code:
Sub Merge2MultiSheets()


'puts all the data from all the sheets on one worksheet

    Dim xRg As Range, zRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    

    
'*** This is where the input range is defined ***'
    xSheetName = "Sheet1"
    xRgStr = "A1:H70"

    
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            

            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal) 'vbnormal
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
                
                Sheets("New Sheet").Cells.Delete Shift:=xlUp
                Sheets("New Sheet 2").Cells.Delete Shift:=xlUp
            
                Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(0, 0)
                Debug.Print xFileName

                
                xFileName = Dir()
                xBook.Close
                

                
            Loop
        End If
    End With
    
    
End Sub
[\code]
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,468
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,383
Messages
5,635,942
Members
416,889
Latest member
dhegs

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