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
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
VBA Code:
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
Last edited by a moderator: