VBA to copy data from multiple workbooks into new master workbook

[MSpicewood]

Good morning,


I'm a VBA novice and having a hard time with my first major project. I've been researching solutions to copy all the data from multiple files (.XLS?) in a directory called "C:/allfiles/" to a newly created master report file.

I need a solution that won't capture any additional blank rows as each file has a different number of entries. I'm also trying to only pull from the first worksheet on each workbook file. These files have a second tab called LOG which I'm trying to exclude.

I have referenced a previous topic here to get started but it's not working out as my specifications are a bit different. Referenced: https://www.mrexcel.com/forum/excel...ata-multiple-workbooks-into-master-sheet.html

Any help is greatly appreciated. Thank you.

 

[MSpicewood]

Bizarre. It's trying to reference a file that isn't in that location.

Run-time error '1004'
'C:\AllFiles\Actions Required-Responses.xlsx' could not be found.
Check the spelling of the file name, and verify that the file location is correct.

If you are trying to open the file from your list of most recently used files, make sure that the file has not been renamed, moved, or deleted.
...
There is no such file in that location. Is it trying to reference my recently used files for some reason? Does my master report file need to be in the same allfiles directory?

 

[Fluff]

Does my master report file need to be in the same allfiles directory?

Nope.
What did the msgbox say?

 

[MSpicewood]

Nope.
What did the msgbox say?

Run-time error '1004'
'C:\AllFiles\Actions Required-Responses.xlsx' could not be found.
Check the spelling of the file name, and verify that the file location is correct.

 

[Fluff]

You should have had a message box appear before the error message.
What did that first message box say?

 

[MSpicewood]

You should have had a message box appear before the error message.
What did that first message box say?

My apologies. With the added msgbox in the macro it displays C:\AllFiles\
Actions Required-Responses.xlsx.

There is no such file in that directory nor would I want it referenced. The file it's complaining about is in my documents and I recently deleted it.

 

[MSpicewood]

Upon further review it seems like any time I delete the file it's complaining about from My documents folder the msgbox references the next file in ascending alphabetical order. Not sure why it's targeting My Documents when I've specified C:/AllFiles/.

 Sub CopyFiles()   
   Dim Mws As Worksheet
   Dim Wbk As Workbook
   Dim Fname As String
   Const Pth As String = "C:\AllFiles\"
   
   Set Mws = ThisWorkbook.Sheets("Master")
   Application.ScreenUpdating = False
   Fname = Dir("*.xls*")
   Do While Fname <> ""
      MsgBox Pth & vbLf & Fname
      Set Wbk = Workbooks.Open(Pth & Fname)
      Wbk.Sheets(1).Range("A1").CurrentRegion.Copy Mws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      Wbk.Close False
      Fname = Dir(Pth & "*.xls*")
   Loop
End Sub

 

[Fluff]

You don't have this amendment from post#8

   Fname = Dir(Pth & "*.xls*")

 

[MSpicewood]

You don't have this amendment from post#8

   Fname = Dir(Pth & "*.xls*")

Wow. I see what went wrong now thank you. The information is now displaying together in the Master worksheet as it should be. I owe you folks big time!

On my individual files the 1st row are titles. How should I go about excluding them?

 

[Fluff]

Try

      Wbk.Sheets(1).Range("A1").CurrentRegion[COLOR=#ff0000].Offset(1)[/COLOR].Copy Mws.Range("A" & Rows.Count).End(xlUp).Offset(1)

 

[MSpicewood]

I'm back again with some output issues when it comes to having multiple files.

When I only have one file in the folder it copies over all the rows correctly including the header row, assuming my header removal lines are commented out as listed in my code below. I have the offset code you offered but also created an extra post loop cleanup process just to test if there was any difference. When there is two or more files to review it will output the headers of each file correctly but only copies the data rows below the header for the last file in the list.

Output example:
Header row A (File 1)
Header row A (File 2)
Header row A (File 3)
Data Row B (File 3)
Data Row C (File 3)
Data Row D (File 3)

One or two of the files only have header A rows and nothing beneath while others can have about 8 rows as the current maximum but this may go up later.

Sub CopyFiles()
   Dim Mws As Worksheet
   Dim Wbk As Workbook
   Dim Fname As String
   Dim r As Integer
   Const Pth As String = "C:\Users\s6372042\Documents\Allfilestest\"
   
   Set Mws = ThisWorkbook.Sheets("Master")
   Application.ScreenUpdating = False
   Fname = Dir(Pth & "*.xls*")
   Do While Fname <> ""
      'MsgBox Pth & vbLf & Fname 'Dir/file location debugger. Uncomment to use.
      Set Wbk = Workbooks.Open(Pth & Fname)
      'Wbk.Sheets(1).Range("A1").CurrentRegion.Offset(1).Copy Mws.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Headers removal during macro. Can only use this OR the line below. Not both.
      Wbk.Sheets(1).Range("A1").CurrentRegion.Copy Mws.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Original sort and copy
      Fname = Dir
      Wbk.Close False
   Loop
   'Post-loop Headers removal. Uncomment the lines below to use.
   'For r = Sheet1.UsedRange.Rows.Count To 1 Step -1
    'If Cells(r, "A") = "FROM" Then
        'Sheet1.Rows(r).EntireRow.Delete
    'ElseIf Cells(r, "A") = "Reviewer" Then
        'Sheet1.Rows(r).EntireRow.Delete
    'End If
    'Next
End Sub