PDA

View Full Version : Macro won't loop through files in folder - opens up first file again and then crashes



rkomenski
06-10-2017, 07:56 PM
Hi - I'm fairly new to macros but I can't figure this one out.
This is a modified script that was being used (successfully) on windows so that may be my problem.
The purpose is to copy data from all workbooks in a folder to a new master sheet.

I can successfully get through the first .xlsx file in the folder but upon looping it opens up the same file and performs the same operation and then crashes excel.

Can anyone help or point me in the right direction?



Sub MergeMultipleWorkbooksToSingleSheet()

Dim CopySheet As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long
Dim CopyRng As Range
Dim DestWBName As String

LastRow = 1

'Delete the sheet "Merged" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Merged").Delete
On Error GoTo 0
Application.DisplayAlerts = True

' Add a sheet to merge everything '
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Merged"

'If the Below directory is forced to My Documents, then use it or Replace the method with a String of the Path '
Path = "/Users/komenr/Desktop/MayDeliverablesForms/MAYFORMS/"
Filename = Dir(Path, MacID("XLSX"))
DestWBName = ActiveWorkbook.Name


' Cycle through all workbooks in the directory '
Do While Filename <> ""

If Filename <> DestWBName Then

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

' Select the first sheet within the workbook *Includes Hidden Sheets'
Sheets(1).Select

' Print sheet name in column A '
DestSh.Cells(LastRow + 1, "A") = Sheets(1).Name

' Fill in the range that you want to copy '
Set CopyRng = Sheets(1).UsedRange

' Copy all values within the used data range '
CopyRng.Copy
With DestSh.Cells(LastRow + 2, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
' Save the row number to start writing from next '
LastRow = DestSh.UsedRange.Rows.Count + 2
Workbooks(Filename).Close
End If
Filename = Dir()
Loop

' AutoFit the columns '
DestSh.Columns.AutoFit

End Sub