Consolidate Sheet1 from multiple workbooks to Master workbook

[spgexcel]

Hi There,

I have a master file with sheet1. A3 to C3 range is header.
I have some workbooks in a folder. All these have data in sheet1.
I am trying to consolidate all these workbooks one below each other without header since header is same.

I have below code but nothing moves an inch. Wonder what must be going wrong.

Sub ConsolidateData()
  Dim wb As Workbook
  Dim wsMaster As Worksheet
  Dim wsSource As Worksheet
  Dim FileName As String
  Dim FolderPath As String
  Dim LastRow As Long

  'Set the folder path where the source files are located
  FolderPath = "C:\Users\New folder"

  'Set the reference to the Master workbook and worksheet
  Set wb = ThisWorkbook
  Set wsMaster = wb.Sheets("Sheet1")

  'Clear all data except headers in Sheet1 of Master workbook
  LastRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row
  wsMaster.Range("A4:C" & LastRow).ClearContents

  'Loop through all Excel files in the specified folder
  FileName = Dir(FolderPath & "*.xlsx*")
  Do While FileName <> ""
    'Open the source workbook and set the reference to the worksheet
    Set wb = Workbooks.Open(FolderPath & FileName)
    Set wsSource = wb.Sheets(1)
    'Find the last row in the source worksheet
    LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    'Copy the data from the source worksheet to the Master worksheet
    wsSource.Range("A4:C" & LastRow).Copy wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    'Close the source workbook without saving changes
    wb.Close False
    'Get the next file name
    FileName = Dir()
  Loop
End Sub

I tried a lot of threads before posting this. I was unable to figure the problem out

Thanks
Spg

 

[DarkDee]

Hi there, I was trying to create a similar macro as well with small differences. When I tried your code I had to modify the path of the source files to end with a "\" ( FolderPath = "C:\Users\New folder\") and I changed the header range to A3:C3. I also modified the code at Set wsSource = wb.Sheets(1) with Set wsSource = wb.Sheets("Sheet1") and it worked like a charm. I'm really new at the vba game and I'm not sure if my feedback will help you in any way but thought of sharing at least.

 

[spgexcel]

Hi there, I was trying to create a similar macro as well with small differences. When I tried your code I had to modify the path of the source files to end with a "\" ( FolderPath = "C:\Users\New folder\") and I changed the header range to A3:C3. I also modified the code at Set wsSource = wb.Sheets(1) with Set wsSource = wb.Sheets("Sheet1") and it worked like a charm. I'm really new at the vba game and I'm not sure if my feedback will help you in any way but thought of sharing at least.

Hi @DarkDee , Thank you for trying this code and giving heads up. I did try all the above mentioned suggestions but still it did not work for me. Do you mind posting your code here in reply to this? I would want to see if I am missing something.

 

[DarkDee]

Sure thing.
Sub MergeIDData()
Dim wb As Workbook
Dim wsMaster As Worksheet
Dim wsSource As Worksheet
Dim FileName As String
Dim FolderPath As String
Dim LastRow As Long

'Set the folder path where the source files are located
FolderPath = "C:\...\test 2\"

'Set the reference to the Master workbook and worksheet
Set wb = ThisWorkbook
Set wsMaster = wb.Sheets("ID") 'I have in my source files as well as in my master file the same sheet named ID

'Clear all data except headers in Sheet1 of Master workbook
LastRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).row
wsMaster.Range("A2:K2" & LastRow).ClearContents 'My header is from A2:K2

'Loop through all Excel files in the specified folder
FileName = Dir(FolderPath & "*.xlsx*")
Do While FileName <> ""
'Open the source workbook and set the reference to the worksheet
Set wb = Workbooks.Open(FolderPath & FileName)
Set wsSource = wb.Sheets("ID")
'Find the last row in the source worksheet
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).row
'Copy the data from the source worksheet to the Master worksheet
wsSource.Range("A2:K2" & LastRow).Copy wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
'Close the source workbook without saving changes
wb.Close False
'Get the next file name
FileName = Dir()
Loop
End Sub