OK, try this one
You only must change the password in the workbooks.open line before you test it
You can edit the cells in this part
With Mybook.Worksheets(1)
BaseWks.Range("B" & rnum).Value = .Range("B4").Value
BaseWks.Range("C" & rnum).Value = .Range("B12").Value
BaseWks.Range("D" & rnum).Value = .Range("B14").Value
BaseWks.Range("E" & rnum).Value = .Range("B15").Value
BaseWks.Range("F" & rnum).Value = .Range("B6").Value
End With
Here is the complete code
Option Explicit
Public MyFiles As String
Sub MacMergeCode()
Dim BaseWks As Worksheet
Dim rnum As Long
Dim CalcMode As Long
Dim MySplit As Variant
Dim FileInMyFiles As Long
Dim Mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
'Add a new workbook that has 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
'Clear MyFiles so that it does not return the old data if no files are found.
MyFiles = ""
'Get the files, set the level of folders and extension.
'Here you are looking in a single main-level folder for all .xls, .xlsx, .xlsm,
'and .xlsb files.
Call GetWorkbooksOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=5)
'Work with the files if MyFiles is not empty
If MyFiles <> "" Then
MySplit = Split(MyFiles, Chr(10))
For FileInMyFiles = LBound(MySplit) To UBound(MySplit)
Set Mybook = Nothing
On Error Resume Next
Set Mybook = Workbooks.Open(Filename:=MySplit(FileInMyFiles), _
Password:="your password", WriteResPassword:=" your password ", UpdateLinks:=0)
On Error GoTo 0
If Not Mybook Is Nothing Then
On Error Resume Next
BaseWks.Range("A" & rnum) = MySplit(FileInMyFiles)
With Mybook.Worksheets(1)
BaseWks.Range("B" & rnum).Value = .Range("B4").Value
BaseWks.Range("C" & rnum).Value = .Range("B12").Value
BaseWks.Range("D" & rnum).Value = .Range("B14").Value
BaseWks.Range("E" & rnum).Value = .Range("B15").Value
BaseWks.Range("F" & rnum).Value = .Range("B6").Value
End With
rnum = rnum + 1
Mybook.Close savechanges:=False
End If
Next FileInMyFiles
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
Function GetWorkbooksOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long)
'Ron de Bruin : 19 April 2012
'Thanks to DJ Bazzie Wazzie (posted on MacScripter) for his great help.
Dim ScriptToRun As String
Dim folderPath As String
On Error Resume Next
folderPath = MacScript("choose folder as string")
If folderPath = "" Then Exit Function
On Error GoTo 0
folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
Chr(34) & " to return quoted form of its POSIX Path")
Select Case ExtChoice
Case 1
ScriptToRun = ScriptToRun & "set streamEditorCommand to " & _
Chr(34) & " | egrep -e '\\.xls$' " & Chr(34) & Chr(13)
Case 2
ScriptToRun = ScriptToRun & "set streamEditorCommand to " & _
Chr(34) & " | egrep -e '\\.xlsx$' " & Chr(34) & Chr(13)
Case 3
ScriptToRun = ScriptToRun & "set streamEditorCommand to " & _
Chr(34) & " | egrep -e '\\.xlsm$' " & Chr(34) & Chr(13)
Case 4
ScriptToRun = ScriptToRun & "set streamEditorCommand to " & _
Chr(34) & " | egrep -e '\\.xlsb$' " & Chr(34) & Chr(13)
Case 5
ScriptToRun = ScriptToRun & "set streamEditorCommand to " & Chr(34) & _
" | egrep -e '\\.xls$' -e '\\.xlsx$' -e '\\.xlsm$' -e '\\.xlsb$'" & _
Chr(34) & Chr(13)
Case Else
ScriptToRun = ScriptToRun & "set streamEditorCommand to " & Chr(34) & _
" | egrep -e '\\.xls$' -e '\\.xlsx$' -e '\\.xlsm$' -e '\\.xlsb$'" & _
Chr(34) & Chr(13)
End Select
ScriptToRun = ScriptToRun & _
"set streamEditorCommand to streamEditorCommand & " & _
Chr(34) & " | tr [/:] [:/] " & Chr(34) & Chr(13)
ScriptToRun = ScriptToRun & _
"set streamEditorCommand to streamEditorCommand & " & _
Chr(34) & " | sed -e " & Chr(34) & " & quoted form of (" & _
Chr(34) & " s.:." & Chr(34) & _
" & (POSIX file " & Chr(34) & "/" & Chr(34) & " as string) & " & _
Chr(34) & "." & Chr(34) & " )" & Chr(13)
ScriptToRun = ScriptToRun & "do shell script " & Chr(34) & "find " & _
folderPath & " \\! -name '.*' -maxdepth " & Level & Chr(34) & _
" & streamEditorCommand without altering line endings"
On Error Resume Next
MyFiles = MacScript(ScriptToRun)
On Error GoTo 0
End Function
