Consulting

Results 1 to 1 of 1

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

  1. #1

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

    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
    Last edited by Bob Phillips; 06-11-2017 at 01:39 PM. Reason: Added code tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •