I use the first worksheet of each workbook in my example (index 1)
Change the worksheet index or fill in a sheet name like: mybook.Worksheets("YourSheetName")
And you can change the range A1:C1 to your range.
With mybook.Worksheets(1)
Set SourceRange = .Range("A1:C1")
End With
On my Windows page (see link above) there are other example that you can adapt for Excel 2011.
Note : When you Run this macro it wil ask you to select the folder with the files
Change the worksheet index or fill in a sheet name like: mybook.Worksheets("YourSheetName")
And you can change the range A1:C1 to your range.
With mybook.Worksheets(1)
Set SourceRange = .Range("A1:C1")
End With
On my Windows page (see link above) there are other example that you can adapt for Excel 2011.
Note : When you Run this macro it wil ask you to select the folder with the files
Sub MergeWorkbooksOnMac() Dim FilesInPath As String Dim MyFiles() As String Dim SourceRcount As Long, FNum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim rnum As Long, CalcMode As Long Dim folderPath As String On Error Resume Next folderPath = MacScript("choose folder as string") If folderPath = "" Then Exit Sub On Error GoTo 0 'If there are no files in the folder exit the sub FilesInPath = Dir(folderPath) 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 <> "" If FilesInPath Like "*.xls" Then FNum = FNum + 1 ReDim Preserve MyFiles(1 To FNum) MyFiles(FNum) = FilesInPath End If FilesInPath = Dir() Loop 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) BaseWks.Range("A1").Font.Size = 36 BaseWks.Range("A1").Value = "Please Wait" rnum = 3 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If FNum > 0 Then For FNum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(folderPath & MyFiles(FNum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next With mybook.Worksheets(1) Set sourceRange = .Range("A1:C1") 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 >= BaseWks.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 >= BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in column A With sourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = MyFiles(FNum) End With 'Set the destrange Set destrange = BaseWks.Range("B" & 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 BaseWks.Columns.AutoFit End If ExitTheSub: BaseWks.Range("A1").Value = "Ready" 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub
No comments:
Post a Comment