VBA copying data from multiple workbooks and worksheets to a Master worksheet

sushil84p

New Member
Joined
Mar 30, 2021
Messages
1
Office Version
  1. 2013
Platform
  1. Windows
VBA copying data from multiple workbooks and worksheets to a Master worksheet

I was successful in copying data from multiple workbooks which had the same headers using the below VBA code but received data into multiple worksheets which I want on a single worksheet as a "Master Consolidated" one.

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




******Please Help*****
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
607
Office Version
  1. 365
Platform
  1. Windows
Do you want to include an XL2BB copy of one or your source workbooks and of the Master sheet ?
This line is copying the whole sheet into the Master Workbook.
tempWorkSheet.Copy After:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Appending just the data is a bit more involved since you need to keep work out the data range of the source workbook's data and what row you are up to in the Master Data Worksheet.
 

KasangoJS

New Member
Joined
Mar 14, 2021
Messages
40
Office Version
  1. 2016
  2. 2013
  3. 2010
Platform
  1. Windows
VBA copying data from multiple workbooks and worksheets to a Master worksheet

I was successful in copying data from multiple workbooks which had the same headers using the below VBA code but received data into multiple worksheets which I want on a single worksheet as a "Master Consolidated" one.

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




******Please Help*****

sushil84p,​

Did you get a solution? I had exactly the same issue and I got the solution right here in this forum! What I dont know is the FORUM POLICY if it allows me to give you the solution. Perhaps an ADMIN can guide us here since I can see you are also new like me?
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
607
Office Version
  1. 365
Platform
  1. Windows

sushil84p,​

Did you get a solution? I had exactly the same issue and I got the solution right here in this forum! What I dont know is the FORUM POLICY if it allows me to give you the solution. Perhaps an ADMIN can guide us here since I can see you are also new like me?

Most of us answering are volunteers, so if you have a suggestion, go for it and post it !
 

KasangoJS

New Member
Joined
Mar 14, 2021
Messages
40
Office Version
  1. 2016
  2. 2013
  3. 2010
Platform
  1. Windows

ADVERTISEMENT

Most of us answering are volunteers, so if you have a suggestion, go for it and post it !
Here is the solution. My headers are on row 1 and 2. Code picks the headers from the first Workbook, Worksheet "Master" then it appends the data from row 3 of every Workbook (Sheets.("Master") until the last Workbook in the folder. Try it out! I have numbered the lines for ease of discussion.

====================================
  1. 'Code courtesy of maabadi, of Mrexcel.com forum
  2. Sub ImportFiles3()
  3. Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
  4. Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
  5. Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
  6. Dim os As Long, LrS As Long, LCS As Long, FileName As String
  7. On Error Resume Next
  8. Set xTWB = ThisWorkbook
  9. Worksheets.Add
  10. Set DestSheet = xTWB.ActiveSheet

  11. Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
  12. With fldr
  13. .Title = "Select a Folder containing files to merge"
  14. .AllowMultiSelect = False
  15. '.InitialFileName = Application.DefaultFilePath
  16. If .Show <> -1 Then GoTo NextCode
  17. sItem = .SelectedItems(1)
  18. End With
  19. NextCode:

  20. FolderName = sItem
  21. Set fldr = Nothing
  22. FolderPath = FolderName & "\"
  23. FileName = Dir(FolderPath & "*.xls*")
  24. Application.ScreenUpdating = False
  25. Application.Calculation = xlCalculationManual
  26. Application.DisplayAlerts = False
  27. Do While FileName <> ""
  28. Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
  29. xStrAWBName = ActiveWorkbook.Name
  30. For Each xWS In ActiveWorkbook.Sheets
  31. If xWS.Name = "Master" Then
  32. Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
  33. LrS = xWS.Range("A" & Rows.Count).End(xlUp).Row
  34. LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  35. LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  36. If Lr = 1 Then
  37. Range(DestSheet.Cells(0, 2), DestSheet.Cells(2, LCS)).Value = Range(xWS.Cells(1, 1), xWS.Cells(2, LCS - 1)).Value
  38. DestSheet.Range("A1").Value = "FileName"
  39. End If
  40. Set Head = xWS.Range("A1")
  41. For os = 0 To xWS.Cells(2, Columns.Count).End(xlToLeft).Column - 1
  42. On Error Resume Next
  43. Header = 0
  44. Header = WorksheetFunction.Match(Head.Offset(0, os), DestSheet.Rows(1), 0)
  45. On Error GoTo 0
  46. If Header = 0 Then
  47. DestSheet.Cells(1, LCD) = Head.Offset(0, os)
  48. Header = LCD
  49. LCD = LCD + 1
  50. End If
  51. If Lr = 1 Then
  52. Range(DestSheet.Cells(Lr + 2, Header), DestSheet.Cells(Lr + LrS - 1, Header)).Value = Range(xWS.Cells(3, os + 1), xWS.Cells(LrS, os + 1)).Value
  53. Else
  54. Range(DestSheet.Cells(Lr + 1, Header), DestSheet.Cells(Lr + LrS - 2, Header)).Value = Range(xWS.Cells(3, os + 1), xWS.Cells(LrS, os + 1)).Value
  55. End If
  56. Next os
  57. If Lr = 1 Then
  58. Range(DestSheet.Cells(Lr + 2, 1), DestSheet.Cells(Lr + LrS - 1, 1)).Value = Left(FileName, Application.WorksheetFunction.Find(".", FileName) - 1)
  59. Else
  60. Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS - 2, 1)).Value = Left(FileName, Application.WorksheetFunction.Find(".", FileName) - 1)
  61. End If
  62. End If
  63. Next xWS
  64. Workbooks(xStrAWBName).Close
  65. FileName = Dir()
  66. Loop

  67. DestSheet.Activate
  68. DestSheet.Name = "xStrAWBName"
  69. Rows("2:2").Select
  70. Selection.AutoFilter
  71. ActiveWindow.FreezePanes = True
  72. Columns("A:EA").EntireColumn.AutoFit

  73. xTWB.Save
  74. Application.StatusBar = False
  75. Sheets("xStrAWBName").Select
  76. Sheets("xStrAWBName").Move
  77. ActiveWorkbook.SaveAs FileName:=Application.GetSaveAsFilename(""), FileFormat:=xlCSV, CreateBackup:=False


  78. Application.ScreenUpdating = True
  79. Application.DisplayAlerts = True
  80. Application.Calculation = xlCalculationAutomatic
  81. MsgBox "MASTERS MERGED for " & xStrAWBName & vbLf & vbLf _
  82. & "YOU CAN NOW FILTER AND KNOCK OUT SETS WITH NO PLANTING DATES!", vbInformation
  83. End Sub
  84. ==========================================================
I wish it could automatically save the file at LINE 83 as the FolderNAME.CSV.
 
Last edited:

KasangoJS

New Member
Joined
Mar 14, 2021
Messages
40
Office Version
  1. 2016
  2. 2013
  3. 2010
Platform
  1. Windows
You will want to remove Line 80 to 83 because, unlike me, you do not need a CSV file.
 

KasangoJS

New Member
Joined
Mar 14, 2021
Messages
40
Office Version
  1. 2016
  2. 2013
  3. 2010
Platform
  1. Windows

ADVERTISEMENT

Here is the solution. My headers are on row 1 and 2. Code picks the headers from the first Workbook, Worksheet "Master" then it appends the data from row 3 of every Workbook (Sheets.("Master") until the last Workbook in the folder. Try it out! I have numbered the lines for ease of discussion.

====================================
  1. 'Code courtesy of maabadi, of Mrexcel.com forum
  2. Sub ImportFiles3()
  3. Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
  4. Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
  5. Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
  6. Dim os As Long, LrS As Long, LCS As Long, FileName As String
  7. On Error Resume Next
  8. Set xTWB = ThisWorkbook
  9. Worksheets.Add
  10. Set DestSheet = xTWB.ActiveSheet

  11. Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
  12. With fldr
  13. .Title = "Select a Folder containing files to merge"
  14. .AllowMultiSelect = False
  15. '.InitialFileName = Application.DefaultFilePath
  16. If .Show <> -1 Then GoTo NextCode
  17. sItem = .SelectedItems(1)
  18. End With
  19. NextCode:

  20. FolderName = sItem
  21. Set fldr = Nothing
  22. FolderPath = FolderName & "\"
  23. FileName = Dir(FolderPath & "*.xls*")
  24. Application.ScreenUpdating = False
  25. Application.Calculation = xlCalculationManual
  26. Application.DisplayAlerts = False
  27. Do While FileName <> ""
  28. Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
  29. xStrAWBName = ActiveWorkbook.Name
  30. For Each xWS In ActiveWorkbook.Sheets
  31. If xWS.Name = "Master" Then
  32. Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
  33. LrS = xWS.Range("A" & Rows.Count).End(xlUp).Row
  34. LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  35. LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  36. If Lr = 1 Then
  37. Range(DestSheet.Cells(0, 2), DestSheet.Cells(2, LCS)).Value = Range(xWS.Cells(1, 1), xWS.Cells(2, LCS - 1)).Value
  38. DestSheet.Range("A1").Value = "FileName"
  39. End If
  40. Set Head = xWS.Range("A1")
  41. For os = 0 To xWS.Cells(2, Columns.Count).End(xlToLeft).Column - 1
  42. On Error Resume Next
  43. Header = 0
  44. Header = WorksheetFunction.Match(Head.Offset(0, os), DestSheet.Rows(1), 0)
  45. On Error GoTo 0
  46. If Header = 0 Then
  47. DestSheet.Cells(1, LCD) = Head.Offset(0, os)
  48. Header = LCD
  49. LCD = LCD + 1
  50. End If
  51. If Lr = 1 Then
  52. Range(DestSheet.Cells(Lr + 2, Header), DestSheet.Cells(Lr + LrS - 1, Header)).Value = Range(xWS.Cells(3, os + 1), xWS.Cells(LrS, os + 1)).Value
  53. Else
  54. Range(DestSheet.Cells(Lr + 1, Header), DestSheet.Cells(Lr + LrS - 2, Header)).Value = Range(xWS.Cells(3, os + 1), xWS.Cells(LrS, os + 1)).Value
  55. End If
  56. Next os
  57. If Lr = 1 Then
  58. Range(DestSheet.Cells(Lr + 2, 1), DestSheet.Cells(Lr + LrS - 1, 1)).Value = Left(FileName, Application.WorksheetFunction.Find(".", FileName) - 1)
  59. Else
  60. Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS - 2, 1)).Value = Left(FileName, Application.WorksheetFunction.Find(".", FileName) - 1)
  61. End If
  62. End If
  63. Next xWS
  64. Workbooks(xStrAWBName).Close
  65. FileName = Dir()
  66. Loop

  67. DestSheet.Activate
  68. DestSheet.Name = "xStrAWBName"
  69. Rows("2:2").Select
  70. Selection.AutoFilter
  71. ActiveWindow.FreezePanes = True
  72. Columns("A:EA").EntireColumn.AutoFit

  73. xTWB.Save
  74. Application.StatusBar = False
  75. Sheets("xStrAWBName").Select
  76. Sheets("xStrAWBName").Move
  77. ActiveWorkbook.SaveAs FileName:=Application.GetSaveAsFilename(""), FileFormat:=xlCSV, CreateBackup:=False


  78. Application.ScreenUpdating = True
  79. Application.DisplayAlerts = True
  80. Application.Calculation = xlCalculationAutomatic
  81. MsgBox "MASTERS MERGED for " & xStrAWBName & vbLf & vbLf _
  82. & "YOU CAN NOW FILTER AND KNOCK OUT SETS WITH NO PLANTING DATES!", vbInformation
  83. End Sub
  84. ==========================================================
I wish it could automatically save the file at LINE 83 as the FolderNAME.CSV.
My issue of the output file being a .CSV has been resolved.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,119
Messages
5,640,218
Members
417,131
Latest member
Seanr19871

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