Copy data from workbooks in folder and subfolders

1. Copy data from workbooks in folder and subfolders

I will in this section demonstrate a macro that automatically opens all workbooks in a folder and subfolders, one by one, and gets data from each sheet copied to a master workbook.

This allows you to quickly merge data across multiple workbooks saving you a lot of time and effort. To be able to consolidate data you need to make sure that data in each sheet begins in cell A1.

The macro selects the current region based on cell A1 in each sheet, then copies the cell range to the master sheet in a new workbook.

For this to work the cells must be contiguous meaning there can't be blank rows or columns in the dataset.

The macro can, however, easily be modified to get a range based on the last non-empty cell in column A.

 

1.1. Macro VBA code

'Name macro
Sub CopWKBooksInFolder()

'Dimension variables and declare data types
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
 
'Insert a new worksheet programmatically
Set WS = Sheets.Add

'Show dialog box and prompt the user for a folder 
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With

'Dir function returns a string representing the name of a file or folder that matches a specified pattern. 
Value = Dir(myfolder)

'Iterate through all files in folder
Do Until Value = ""

    'Check that file name is not . (dot) or .. (two dots)
    If Value = "." Or Value = ".." Then

    'Continue here if file name is not . (dot) or .. (two dots)
    Else

        'Check if file extension matches xls, xlsx or xlsm
        If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then

            'Enable error handling
            On Error Resume Next

            'Check if file is password protected
            Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"

            'Check if an error has occurred
            If Err.Number > 0 Then

            'Continue here if an error has not occureed
            Else
 
                'Disable error handling
                On Error GoTo 0

                'Iterate through each worksheet in active workbook
                For Each sht In ActiveWorkbook.Worksheets

                    'Check if first cell A1 is not empty
                    If sht.Range("A1") <> "" Then

                        'Find last non-empty cell in column A
                        Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1

                        'Copy cells
                        sht.Range("A1").CurrentRegion.Copy Destination:=WS.Range("A" & Lrow)
                    End If

                'Continue with the next worksheet
                Next sht
            End If

            'Close active workbook
            Workbooks(Value).Close False

            'Disable error handling
            On Error GoTo 0
        End If
    End If
    Value = Dir

'Continue with next file
Loop

'Adjust column width
Cells.EntireColumn.AutoFit
End Sub

1.2. Where to copy the code?

1. Copy above macro
2. Go to VBA Editor (Alt+F11)
3. Press with left mouse button on "Insert" on the top menu
4. Press with left mouse button on "Module" to insert a module to your workbook
5. Paste code into the code window
6. Exit VBA Editor and return to Excel (Alt+Q)

1.3. Save the workbook

To be able to use the macro next time you open your workbook you need to save the workbook as a macro-enabled workbook.

1. Press with left mouse button on "File" on the menu, or if you have an earlier version of Excel, press with left mouse button on the office button.
2. Press with left mouse button on "Save As"
3. Press with left mouse button on file extension drop-down list
   
4. Change the file extension to "Excel Macro-Enabled Workbook (*.xlsm)".
   

1.4. How to use the macro?

1. Open the Macro dialog box (Alt + F11)
   
2. Select CopWKBooksInFolder.
3. Press with left mouse button on "Run" button.
4. A folder dialog box appears.
   
5. Navigate to a folder you want to search.
6. Press with left mouse button on OK button.
7. The macro starts opening workbooks, one by one, copying values to a master worksheet.

The picture above demonstrates a master worksheet, even the headers are copied to the worksheet.

1.5. Copy data ignore headers

The following macro copies all data from the first opened workbook and worksheet, worksheets after that ignores the header row.

There is only one header row in the picture above.

Sub CopWKBooksInFolder()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
 
Set WS = Sheets.Add
 
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With
chk = 0
Value = Dir(myfolder)
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
            On Error Resume Next
            Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
            If Err.Number > 0 Then
            Else
                On Error GoTo 0
                For Each sht In ActiveWorkbook.Worksheets
                    If sht.Range("A1") <> "" Then
                        Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
                        If chk = 0 Then
                            sht.Range("A1").CurrentRegion.Copy Destination:=WS.Range("A" & Lrow)
                            chk = 1
                        Else
                            Set crng = sht.Range("A1").CurrentRegion
                            Set crng = crng.Offset(1, 0)
                            Set crng = crng.Resize(crng.Rows.Count - 1)
                            crng.Copy Destination:=WS.Range("A" & Lrow)
                        End If
                    End If
                Next sht
            End If
            Workbooks(Value).Close False
            On Error GoTo 0
        End If
    End If
    Value = Dir
Loop
Cells.EntireColumn.AutoFit
End Sub

1.6. Copy data from specific worksheets in folders based on paths

This macro ignores header rows except the first one, as well. It also allows you to copy data from worksheets whose names contain a specific text string.

The the macro allows you to select a cell range containing search paths to folders you want to search.

Sub CopWKBooksInFolder()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet

Str = Application.InputBox(prompt:="Search only sheet names containing this string:", Title:="Search worksheet whose name contain this string:", Type:=2)

On Error Resume Next
Set Rng = Application.InputBox(prompt:="Select a cell range containing paths to folders" _
, Title:="Select a cell range", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0

Set WS = Sheets.Add

For Each cell In Rng

    If Dir(cell.Value, vbDirectory) <> "" Then
    
        chk = 0
        Value = Dir(cell.Value)
        
        Do Until Value = ""
            If Value = "." Or Value = ".." Then
            Else
                If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
                    On Error Resume Next
                    Workbooks.Open Filename:=cell.Value & Value, Password:="zzzzzzzzzzzz"
                    If Err.Number > 0 Then
                    Else
                        On Error GoTo 0
                        For Each sht In ActiveWorkbook.Worksheets

                            If InStr(sht.Name, Str) <> 0 Then
                            
                                If sht.Range("A1") <> "" Then
                                    Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1

                                    If chk = 0 Then
                                        sht.Range("A1").CurrentRegion.Copy Destination:=WS.Range("A" & Lrow)
                                        chk = 1
                                    Else
                                        Set crng = sht.Range("A1").CurrentRegion
                                        Set crng = crng.Offset(1, 0)
                                        Set crng = crng.Resize(crng.Rows.Count - 1)
                                        crng.Copy Destination:=WS.Range("A" & Lrow)
                                    End If
                                End If
                            End If
                        Next sht
                    End If
                    Workbooks(Value).Close False
                    On Error GoTo 0
                End If
            End If
            Value = Dir
        Loop
    End If
Next cell
Cells.EntireColumn.AutoFit
End Sub

2. Move data to workbooks

This section demonstrates a VBA macro that saves user input to a given workbook and worksheet programmatically. Macros are great for doing repetitive tasks, this saves you the steps to open a workbook, select a worksheet, save values to cells and lastly save the workbook and close.

This article demonstrates how to programmatically:

• Open a workbook based on a workbook name saved in a specific cell.
• Populate empty cells in the opened workbook with values.
• Create a new workbook if the workbook name doesn't exist.
• Insert a new worksheet if non-existing.
• Save changes

2.1 How the macro works

The Excel user enters a name, country, company, workbook, and worksheet name in cell range B3:F3. Then press the "Save record" button, see image above.

The macro tries to open the workbook in the same folder and copies cell range B3:F3 to the first empty row on the sheet. It then closes and saves the workbook.

If the workbook file can't be found it creates a new workbook and copies cell range B3:F3 to the first empty row on the sheet.

If the worksheet is not found the macros insert a new sheet and renames it. Then copies cell range B3:F3 to the first empty row.

Here is a flow chart.

Back to top

2.2 VBA code

'Name macro
Sub Move_record_to_workbook()

'Save active workbook name to variable Wbs
Wbs = ActiveWorkbook.Name

'Save value in cell F3 to variable WSName
WSName = Range("F3").Value

'Save value in cell E3 to variable WBName
WBName = Range("E3").Value

'Enable error handling
On Error Resume Next

'Open workbook using path of active workbook and string in variable WBName
Workbooks.Open Filename:=Application.ActiveWorkbook.Path & "\" & WBName

'Check if an arror has occurred
If Err > 0 Then

    'Disable error handling
    On Error GoTo 0

    'Insert a new worksheet
    Workbooks.Add

    'Enable error handling
    On Error Resume Next

    'Activate worksheet WSName
    ActiveWorkbook.Worksheets(WSName).Activate

    'Check if an arror has occurred, if so insert a new worksheet
    If Err > 0 Then Worksheets.Add(After:=Worksheets(1)).Name = WSName

    'Disable error handling
    On Error GoTo 0
End If

'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
With ActiveWorkbook.Worksheets(WSName)

    'Save row of first empty cell in column A to variable Lrow
    Lrow = .Range("A" & Rows.Count).End(xlUp).Row

    'Check if cell value is not equal to nothing, if so add 1 to variable Lrow
    If .Range("A" & Lrow).Value <> "" Then Lrow = Lrow + 1
End With

'Copy values in cell range B3:F3, Sheet1 to a row in worksheet WSName based on row number in variable Lrow
ActiveWorkbook.Worksheets(WSName).Range("A" & Lrow & ":C" & Lrow) = Workbooks(Wbs).Worksheets("Sheet1").Range("B3:F3").Value

'Save and close Workbook
ActiveWorkbook.Close SaveChanges:=True
End Sub

Back to top

2.3 Where to put the macro?

1. Press shortcut keys Alt+F11 to open the Visual Basic Editor.
2. Press with mouse on "Insert" on the top menu.
3. Press with left mouse button on "Module" to insert a new module to your workbook.
4. Paste VBA code to window.
5. Exit VB Editor and return to Excel.

Back to top

2.4 How to link macro to a button?

1. Go to tab "Developer". If tab "Developer" is missing.
2. Press with left mouse button on the "Insert" button on the ribbon.
3. Another menu shows up. Press with left mouse button on the button (Form Controls).
4. Press and hold with left mouse button on worksheet where you want to place the button.
5. Drag with mouse to size the button.
6. Release left mouse button.
7. A dialog box appears. Press with left mouse button on macro name "Move_record_to_workbook" to select it.
   
8. Press with left mouse button on OK button to assign macro "Move_record_to_workbook" to the button.

You can move and resize the button using the handles if you are not happy with the location or size.

Back to top

Back to top

3. Copy each sheet in active workbook to new workbooks

The following macro copies each sheet in the current workbook to new workbooks.

VBA code

'Name macro
Sub CopySheetsToNewWorkbooks()

'Dimension variable and declare data types
Dim SHT As Worksheet

'Iterate through worksheets in active workbook
For Each SHT In ActiveWorkbook.Worksheets

'Copy worksheet to a new workbook
SHT.Copy

'Continue with next worksheet in acteive workbook
Next

'Stop macro
End Sub

Back to top

4. Copy selected sheets to new workbooks

If a sheet contains a list (excel 2003) or a table (excel 2007) you can't only use the SelectedSheets property to copy selected sheets. This article by Ron de Bruin explains a workaround: Copying Worksheets with a List or Table

• Press and hold Ctrl and select multiple sheets in your workbook
• Run CopySelectedSheetsToNewWorkbooks macro

VBA code

'Name macro
Sub CopySelectedSheetsToNewWorkbooks()

'Dimension variable and declare data types
Dim AW As Window

'The SET statement saves the active window as an object reference to variable AW
Set AW = ActiveWindow

'Iterate through selected worksheets based on active window
For Each SHT In AW.SelectedSheets

'The NewWindow method creates a new window based on the active window using an object reference saved to variable TempWindow
Set TempWindow = AW.NewWindow

'Copy worksheet to a new workbook
SHT.Copy

'Close the newly created window
TempWindow.Close

'Continue with next worksheet
Next

'Stop macro
End Sub

Back to top

5. Copy sheets in every open workbook to a master workbook

This macro copies all sheets in all open workbooks to a singlemaster workbook.

'Name macro
Sub CopySheetsToMasterWorkbook()

'Dimension variables and declare data types
Dim WBN As Workbook, WB As Workbook
Dim SHT As Worksheet

'Create a new workbook and save an object reference to variable WBN
Set WBN = Workbooks.Add

'Iterate through all open workbooks
For Each WB In Application.Workbooks

'Check if workbook name of object variable WB is not equal to name of object variable WBN
If WB.Name <> WBN.Name Then

'Go through all worksheets in object WB
For Each SHT In WB.Worksheets

'Copy worksheet to workbook WBN and place after the last worksheet
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)

'Continue with next worksheet
Next SHT

'End of If statement
End If

'Continue with next workbook
Next WB

'Disable Alerts
Application.DisplayAlerts = False

'Delete sheet1, sheet2 and sheet3 in the new workbook WBN
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete

'Enable Alerts
WBN.Application.DisplayAlerts = True

'End macro
End Sub

Back to top

5.1 Add workbook name to sheets

Perhaps you want to know where each sheet in the master workbook came from? The following line adds the original workbook name to the sheet name.

Copy and paste this line

WBN.Sheets(WBN.Worksheets.Count).Name = Left(WB.Name, 30 - Len(SHT.Name)) & "-" & SHT.Name

after this line

SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)

in the macro above.

Back to top

5.2 Where to put the macros?

1. Press Alt+ F11 to open the Visual Basic Editor.
2. Select your workbook in the Project Explorer window.
3. Press with left mouse button on "Insert" on the menu.
4. Press with left mouse button on "Module" to create a module.
5. Paste code to module.
6. Return to Excel.

Back to top

Recommended reading

10 ways to reference Excel workbooks and sheets using VBA

Back to top

6. List all open workbooks and corresponding sheets - VBA

In this post, I am going to demonstrate how to automatically create a new sheet in the current workbook and list all open workbooks and their sheets using a VBA macro.

The image above shows the new worksheet, it contains the names of the workbooks and corresponding worksheets I have currently open.

Macro code

'Name macro
Sub ListWorkbooks()

'Declare variables and data types
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Single, j As Single

'Create a new worksheet and save to object ws
Set ws = Sheets.Add

'Go through open workbooks
For j = 1 To Workbooks.Count

    'Save workbook name to cell A1 and downwards
    Range("A1").Cells(j, 1) = Workbooks(j).Name
    
    'Iterate through worksheets in given workbook
    For i = 1 To Workbooks(j).Sheets.Count
  
            'Save worksheet names to cell B1 and cells further right
            Range("A1").Cells(j, i + 1) = Workbooks(j).Sheets(i).Name

    'Continue with next worksheet
    Next i

'Continue with next workbook
Next j
End Sub

How to copy the macro to your workbook

1. Press Alt+F11 to open the VB Editor.
2. Press with right mouse button on on your workbook in the Project Explorer.
3. Press with left mouse button on "Insert" and then "Module".
4. Copy macro code.
5. Press with left mouse button on in code module window to see the input prompt.
6. Paste code to code module.
7. Return to Excel.

How to run the macro

1. Go to "Developer" tab on the ribbon.
2. Press with left mouse button on "Macros" button.
3. Select "ListWorkbooks" macro.
4. Press with left mouse button on "Run" button.

Files and folders category

Macro category

Vba category

More than 1300 Excel formulas

Excel categories

Comments (5)