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 
    
    
    Formatting tags added by mark007
    Last edited by xld; 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
  •