VBA Help - Pull Excel WB's from a specific folder into WB

[psrs0810]

I have a list of reports I need to look at. Is there an easy way for me to setup a macro to run that will go to this one folder and put each file it finds into the one workbook?
Each Excel file is only 1 sheet and when this gets pulled into the consolidated workbook if it can rename the sheet to the file name?
Thanks

This is something that I have used many years ago and I know VBA has enhanced. Where I am getting held up (right now) is when it opens a file and tries to copy - it does not copy.
any help would be greatly appreciated

Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer

'Clear Contents
Sheets("Summary").Select
Range("A:D").Select
    Selection.Delete

    RowofCopySheet = 1 ' Row to start on in the sheets you are copying from

    ThisWB = ActiveWorkbook.Name

    path = ("\\pmhfile\sebasp\Budget\FY21\EPSi P&L\test")

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets("Summary")
Filename = Dir(path & "\*.xlsx", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 0)
CopyRng.Copy
Sheets("Summary").Select
Range("A1").Select
Dest.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'Clear Clipboard
Wkb.Close False
End If

Filename = Dir()
Loop


Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"
End Sub

 

[JLGWhiz]

See if this does what you want. I don't know why the four columns were deleted in sheet Summary, but I left than in and if not needed just delete the two lines that refer to it of comment them out, whichever you prefer.

Sub MergeFiles2()
Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
fPath = ("\\pmhfile\sebasp\Budget\FY21\EPSi P&L\test\")
Set sh = ThisWorkbook.Sheets("Summary")
sh.Range("A:D").ClearContents
fName = Dir(fPath & "*.xlsx")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
                wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Left(wb.Name, InStr(wb.Name, ".") - 1)
                wb.Close False
        End If
        fName = Dir
    Loop
End Sub

 

[psrs0810]

the good new is, I did not get a debug error. the bad news is that it did not pull the files into this workbook
once the macro gets to Do While fName <> "", it skips to End Sub

 

[JLGWhiz]

Make sure that fPath is initialized.

fPath = ("\\pmhfile\sebasp\Budget\FY21\EPSi P&L\test\")

Open your vb editor and click anywhere in the body of the code then press the F8 key. You can then step through the code line by line. Hover the mouse pointer over the variables to see if they are initialized after that line executes. I am leary of web paths that are not mapped to a logical drive like F:\ or X:\ , etc. when using them in code like this. You can try removing the parentheses from the path, jut leave the quote marks.

 

[JLGWhiz]

the path has to be the problem, because it worked for me using a local path. If you do not have a directory named 'test' then it will return an empty string.

 

[psrs0810]

This did work - Thanks

 

[JLGWhiz]

This did work - Thanks

I don't know what worked, but if you are now able to use the code, good.
Regards, JLG