Multiple Workbooks to one.

[Claire Jackson]

Hi, I have multiple workbooks with weekly tabs where users add data (basically a spreadsheet that captures an employees name and what work he is doing that day for a full week per tab). Each Manager uses separate spreadsheets but I want to be able to print a list of each manager's entries on one single piece of paper, so I found the below on the web but although it brings the data in, it still puts it on separate sheets. Is there a way of combining the identically labelled tabs into just one sheet?

Sub mergeFiles()

'Merges all files in a folder to a main file.
'Define variables:

Dim numberOfFilesChosen, i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet

Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
'Allow the user to select multiple workbooks

tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
'Loop through all selected workbooks

For i = 1 To tempFileDialog.SelectedItems.Count
'Open each workbook

Workbooks.Open tempFileDialog.SelectedItems(i)

Set sourceWorkbook = ActiveWorkbook
'Copy each worksheet to the end of the main workbook

For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)

Next tempWorkSheet
'Close the source workbook
sourceWorkbook.Close

Next i

End Sub

 

[dmt32]

Hi,
untested but try this update to your code & see if does what you want

Sub mergeFiles()
    
    'Merges all files in a folder to a main file.
    'Define variables:
    
    Dim tempFileDialog      As FileDialog
    Dim numberOfFilesChosen As Long, i As Long
    Dim sourceWorkbook      As Workbook
    Dim rngData             As Range
    Dim ExcludeHeader       As Boolean
    Dim tempWorkSheet       As Worksheet, mainsheet As Worksheet
    
    '----------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------
    'master sheet
    Set mainsheet = ThisWorkbook.Worksheets("Sheet1")
    
    'set True to exlclude row 1 header row
    ExcludeHeader = False
    
    '----------------------------------------------------------------------------------------------
    
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    'Allow the user to select multiple workbooks
    With tempFileDialog
        .AllowMultiSelect = True
        numberOfFilesChosen = .Show
    End With
    
    'cancel pressed
    If numberOfFilesChosen = 0 Then Exit Sub
    
    On Error GoTo myerror
    
    Application.ScreenUpdating = False
    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
        'Open each workbook
        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i), 0, True)
        'Copy each worksheet to main worksheet
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            Set rngData = tempWorkSheet.UsedRange
            If ExcludeHeader Then Set rngData = rngData.Offset(1).Resize(rngData.Rows.Count - 1)
            rngData.Copy mainsheet.Cells(mainsheet.Cells(mainsheet.Rows.Count, "A").End(xlUp).Row + 1, 1)
            Set rngData = Nothing
        Next tempWorkSheet
        
        'Close the source workbook
        sourceWorkbook.Close False
        Set sourceWorkbook = Nothing
    Next i
    
myerror:
    If Not sourceWorkbook Is Nothing Then sourceWorkbook.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Change sheet names shown in BOLD as required

I have also include option to excluded the 1st row( header) if required

Dave

 

[jkpieterse]

Have you tried Data, Get Data, From File, From Folder?

 

[Claire Jackson]

Hi,
untested but try this update to your code & see if does what you want

Sub mergeFiles()
   
    'Merges all files in a folder to a main file.
    'Define variables:
   
    Dim tempFileDialog      As FileDialog
    Dim numberOfFilesChosen As Long, i As Long
    Dim sourceWorkbook      As Workbook
    Dim rngData             As Range
    Dim ExcludeHeader       As Boolean
    Dim tempWorkSheet       As Worksheet, mainsheet As Worksheet
   
    '----------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------
    'master sheet
    Set mainsheet = ThisWorkbook.Worksheets("Sheet1")
   
    'set True to exlclude row 1 header row
    ExcludeHeader = False
   
    '----------------------------------------------------------------------------------------------
   
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
   
    'Allow the user to select multiple workbooks
    With tempFileDialog
        .AllowMultiSelect = True
        numberOfFilesChosen = .Show
    End With
   
    'cancel pressed
    If numberOfFilesChosen = 0 Then Exit Sub
   
    On Error GoTo myerror
   
    Application.ScreenUpdating = False
    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
        'Open each workbook
        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i), 0, True)
        'Copy each worksheet to main worksheet
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            Set rngData = tempWorkSheet.UsedRange
            If ExcludeHeader Then Set rngData = rngData.Offset(1).Resize(rngData.Rows.Count - 1)
            rngData.Copy mainsheet.Cells(mainsheet.Cells(mainsheet.Rows.Count, "A").End(xlUp).Row + 1, 1)
            Set rngData = Nothing
        Next tempWorkSheet
       
        'Close the source workbook
        sourceWorkbook.Close False
        Set sourceWorkbook = Nothing
    Next i
   
myerror:
    If Not sourceWorkbook Is Nothing Then sourceWorkbook.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Change sheet names shown in BOLD as required

I have also include option to excluded the 1st row( header) if required

Dave

This works marvellously, thank you but instead of appending to the bottom each time I run the macro, can it overwrite the contents completely with new data from the Managers spreadsheets?

 

[dmt32]

This works marvellously, thank you but instead of appending to the bottom each time I run the macro, can it overwrite the contents completely with new data from the Managers spreadsheets?

try adding line shown in bold & see if this does what you want

Sub mergeFiles()
    
    'Merges all files in a folder to a main file.
    'Define variables:
    
    Dim tempFileDialog      As FileDialog
    Dim numberOfFilesChosen As Long, i As Long
    Dim sourceWorkbook      As Workbook
    Dim rngData             As Range
    Dim ExcludeHeader       As Boolean
    Dim tempWorkSheet       As Worksheet, mainsheet As Worksheet
    
    '----------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------
    'master sheet
    Set mainsheet = ThisWorkbook.Worksheets("Sheet1")
    
    'set True to exlclude row 1 header row
    ExcludeHeader = False
    
    '----------------------------------------------------------------------------------------------
    

    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    'Allow the user to select multiple workbooks
    With tempFileDialog
        .AllowMultiSelect = True
        numberOfFilesChosen = .Show
    End With
    
    'cancel pressed
    If numberOfFilesChosen = 0 Then Exit Sub
    
    On Error GoTo myerror
    
    Application.ScreenUpdating = False
    
    'clear previous manager records
    mainsheet.UsedRange.ClearContents

'rest of code

Dave

 

[Claire Jackson]

try adding line shown in bold & see if this does what you want

Sub mergeFiles()
    
    'Merges all files in a folder to a main file.
    'Define variables:
    
    Dim tempFileDialog      As FileDialog
    Dim numberOfFilesChosen As Long, i As Long
    Dim sourceWorkbook      As Workbook
    Dim rngData             As Range
    Dim ExcludeHeader       As Boolean
    Dim tempWorkSheet       As Worksheet, mainsheet As Worksheet
    
    '----------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------
    'master sheet
    Set mainsheet = ThisWorkbook.Worksheets("Sheet1")
    
    'set True to exlclude row 1 header row
    ExcludeHeader = False
    
    '----------------------------------------------------------------------------------------------
    

    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    'Allow the user to select multiple workbooks
    With tempFileDialog
        .AllowMultiSelect = True
        numberOfFilesChosen = .Show
    End With
    
    'cancel pressed
    If numberOfFilesChosen = 0 Then Exit Sub
    
    On Error GoTo myerror
    
    Application.ScreenUpdating = False
   
    'clear previous manager records
    mainsheet.UsedRange.ClearContents

'rest of code

Dave

Thanks, it works except it is now removing row1 (headers). Also as the Manager's are using the same files, is there a way that I can get it to automatically pull the data from these files instead of having to select them.

 

[dmt32]

Thanks, it works except it is now removing row1 (headers).

try replacing the new line with this

'clear previous managervrecords
    mainsheet.UsedRange.Offset(1).ClearContents

Also as the Manager's are using the same files, is there a way that I can get it to automatically pull the data from these files instead of having to select them.

You could create an array of the files & loop through that.

The array could be hard coded

e.g.

Dim arrManagerFiles As Variant
arrManagerFiles = Array("File1.xlsx","File2.xlsx")

or you could create a list of files in a table on another worksheet for it to read from

29-02-2024.xls
	A
1	Manager Files
2	File1
3	File2
Manager Files

Dim tblFiles        As ListObject
Dim arrManagerFiles As Variant

Set tblFiles = Worksheets("Manager Files").ListObjects(1)

arrManagerFiles = tblFiles.DataBodyRange.Value

Advantage of using a table is that you can add to it quite easily & also, you can create additional tables of same sheet for other managers negating need to adjust your code.


Dave

 

[Claire Jackson]

try replacing the new line with this

'clear previous managervrecords
    mainsheet.UsedRange.Offset(1).ClearContents

You could create an array of the files & loop through that.

The array could be hard coded

e.g.

Dim arrManagerFiles As Variant
arrManagerFiles = Array("File1.xlsx","File2.xlsx")

or you could create a list of files in a table on another worksheet for it to read from

29-02-2024.xls
	A
1	Manager Files
2	File1
3	File2
Manager Files

Dim tblFiles        As ListObject
Dim arrManagerFiles As Variant

Set tblFiles = Worksheets("Manager Files").ListObjects(1)

arrManagerFiles = tblFiles.DataBodyRange.Value

Advantage of using a table is that you can add to it quite easily & also, you can create additional tables of same sheet for other managers negating need to adjust your code.


Dave

ALmost there now thanks t you. Anyway, i have used your suggestion but it's still asking me to select the files so which are the portions that I need to turn off?

 

[dmt32]

ALmost there now thanks t you. Anyway, i have used your suggestion but it's still asking me to select the files so which are the portions that I need to turn off?

If you no longer need the FileDialogPicker then remove these lines

Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

'Allow the user to select multiple workbooks
    With tempFileDialog
        .AllowMultiSelect = True
        numberOfFilesChosen = .Show
    End With

and your loop would change from this

'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
        'Open each workbook
        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i), 0, True)

to this

For i = 1 To UBound(arrManagerFiles, 1)
        'Open each workbook
        Set sourceWorkbook = Workbooks.Open(arrManagerFiles(i), 0, True)

This assumes that your array is reading from a table

Dave

 

[Claire Jackson]

If you no longer need the FileDialogPicker then remove this line

Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

and your loop would change from this

'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
        'Open each workbook
        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i), 0, True)

to this

For i = 1 To UBound(arrManagerFiles, 1)
        'Open each workbook
        Set sourceWorkbook = Workbooks.Open(arrManagerFiles(i), 0, True)

This assumes that your array is reading from a table

Dave

It's now not pulling any data through, This is the full code now.

Sub mergeFiles()

'Merges all files in a folder to a main file.
'Define variables:

Dim tempFileDialog As FileDialog
Dim numberOfFilesChosen As Long, i As Long
Dim sourceWorkbook As Workbook
Dim rngData As Range
Dim ExcludeHeader As Boolean
Dim tempWorkSheet As Worksheet, mainsheet As Worksheet

Dim tblFiles As ListObject
Dim arrManagerFiles As Variant

Set tblFiles = Worksheets("Manager Files").ListObjects(1)

arrManagerFiles = tblFiles.DataBodyRange.Value



'----------------------------------------------------------------------------------------------
' SETTINGS
'----------------------------------------------------------------------------------------------
'master sheet
Set mainsheet = ThisWorkbook.Worksheets("Sheet1")

'set True to exclude row 1 header row
ExcludeHeader = True

'----------------------------------------------------------------------------------------------

' Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

'Allow the user to select multiple workbooks
' With tempFileDialog
' .AllowMultiSelect = True
' numberOfFilesChosen = .Show
' End With

'cancel pressed
If numberOfFilesChosen = 0 Then Exit Sub

On Error GoTo myerror

Application.ScreenUpdating = False
'Loop through all selected workbooks

'clear previous manager records
mainsheet.UsedRange.Offset(1).ClearContents

' For i = 1 To tempFileDialog.SelectedItems.Count
' 'Open each workbook
' Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i), 0, True)

For i = 1 To UBound(arrManagerFiles, 1)
'Open each workbook
Set sourceWorkbook = Workbooks.Open(arrManagerFiles(i), 0, True)



'Copy each worksheet to main worksheet
For Each tempWorkSheet In sourceWorkbook.Worksheets
Set rngData = tempWorkSheet.UsedRange
If ExcludeHeader Then Set rngData = rngData.Offset(1).Resize(rngData.Rows.Count - 1)
rngData.Copy mainsheet.Cells(mainsheet.Cells(mainsheet.Rows.Count, "A").End(xlUp).Row + 1, 1)
Set rngData = Nothing
Next tempWorkSheet

'Close the source workbook
sourceWorkbook.Close False
Set sourceWorkbook = Nothing
Next i

myerror:
If Not sourceWorkbook Is Nothing Then sourceWorkbook.Close False
Application.ScreenUpdating = True
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

'Change sheet names shown in BOLD as required

'I have also include option to excluded the 1st row( header) if required