Merging multiple workbooks into one from a folder

HappyBear

New Member
Joined
May 16, 2022
Messages
2
Office Version
  1. 2021
Platform
  1. MacOS
I have adapted a code from RDB for my use where I want to merge multiple files into one workbook. I've read through other posts but I can't find the same issue I am having. I am running Mac OS12 and Excel 2019.
VBA Code:
Sub Basic_Dir_Example_Mac()
'Ron de Bruin, 27-Feb-2019
'Only for Mac Excel  365 with the latest updates
    Dim MyPath As String, FilesInPath As String
    Dim Fnum As Long, MyFiles() As String
    Dim Nwb As Workbook
    Dim Mybook As Workbook
    Dim rnum As Long
    Dim sourceRange As Range
    Dim destrange As Range
    Dim SourceRcount As Long
    Dim CalcMode As Long
    
    On Error Resume Next
    MyPath = MacScript("return posix path of (choose folder with prompt ""Select the folder"") as string")
    If MyPath = "" Then Exit Sub
    On Error GoTo 0
    
    rnum = 4
     'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "*.csv*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    'Fill the array(myFiles) with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
        
         ' Add a new workbook to copy the list of files in
        Set Nwb = Workbooks.Add
        With Nwb.Sheets(1).Range("A3:I3")
            .Value = Array("384 well Plate", "384 Well", "96 Well", "96 well ID", "Barcode", "Well ID", "665 nm", "620 nm", "Ratio")
            .Font.Bold = True
        End With
        
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
          On Error Resume Next
          
          Set Mybook = Nothing
            On Error Resume Next
            [B]Set Mybook = Workbooks.Open(MyFiles(Fnum))[/B]
            On Error GoTo 0

            If Not Mybook Is Nothing Then

                On Error Resume Next
            
                With Mybook.Worksheets(1)
                    Set sourceRange = .Range("B4:F387")
                End With

                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    'if SourceRange use all columns then skip this file
                    If sourceRange.Columns.Count >= Mybook.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0
                
                If Not sourceRange Is Nothing Then

                    SourceRcount = sourceRange.Rows.Count

                    If rnum + SourceRcount >= Mybook.Rows.Count Then
                        MsgBox "Sorry there are not enough rows in the sheet"
                        Mybook.Columns.AutoFit
                        Mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else
                    
                    Set destrange = Nwb.Sheets(1).Range("E" & rnum)

                        'we copy the values from the sourceRange to the destrange
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value

                        rnum = rnum + SourceRcount
                    End If
                End If
                Mybook.Close savechanges:=False
            End If

        Next Fnum
        Nwb.Sheets(1).Columns.AutoFit
    End If
    
ExitTheSub:

    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With

End Sub
The problem I am running into is Mybook does not change from Nothing to the file I want to open even though MyFiles(Fnum) shows the correct file. Any help with this would be greatly appreciated. Thanks!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
In your code, it has:
VBA Code:
[B]Set Mybook = Workbooks.Open(MyFiles(Fnum))[/B]
Is that how it looks in your code, or did you try and bold it so it would stand out? If the former, you need to delete the [ B] and [/ B] obviously, but I'm thinking it's probably the latter.

Looking briefly at your code, assuming that the MyFiles(Fnum) does, as you say, show the full path to the file (and not just the filename), then the problem is probably getting masked by all the
On Error Resume Next lines you have in your code. I would suggest removing them all for now. I appreciate it can get annoying because it keeps throwing error messages at you, but those error messages are trying to help you, and when you use this line of code, you're ultimately causing yourself more confusion because it's hiding the problem, most likely.
 
Upvote 0
Solution
Thanks, @Dan_W. You are correct about the , it was just to show where the problem occurred. I actually discovered the problem soon after I posted and it was putting in the full path of the files as you said. Thanks for your reply.
 
Upvote 0
Awesome. Glad it's now working.
But all the same, I still think you should remove the On Error Resume Next lines, because it will probably save you some headaches later on.
 
Upvote 0

Forum statistics

Threads
1,215,051
Messages
6,122,872
Members
449,097
Latest member
dbomb1414

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top