Sub Merge()
Dim File As String
Dim AllFiles(), Filename As Variant
Dim count, test, StartRow, LastRow, LastColumn As Long
Dim LastCell As Variant
test = 0
ChDir "C:\" 'Insert suitable directory for your computer ex:ChDir "C:\Users\Jerry Hou\" if file of interest is in "Jerry Hou" Folder
ReDim AllFiles(1)
Do
Application.EnableCancelKey = xlDisabled
File = Application.GetOpenFilename("XML Files (*.xml),*.xml", 1, "Select File to be Merged") 'Needs to select in Order to merge files
Application.EnableCancelKey = xlErrorHandler
If (File = "False") Then Exit Do
ReDim Preserve AllFiles(count) 'Preserve ?
AllFiles(count) = File 'File== file name and directory
count = (count + 1)
If (MsgBox("Select Another File To be Merged With?", vbQuestion + vbOKCancel, "Merge Files") = vbCancel) Then Exit Do
Loop 'Select Cancel in MsgBox to finish merge file(s) selection
If (count = 0) Then
MsgBox "No selection" 'If you hit Exit from open prompt window
Exit Sub
End If
For count = 0 To UBound(AllFiles)
MsgBox "User selected file name: " & AllFiles(count)
Next
test = count
For test = UBound(AllFiles) To LBound(AllFiles) Step -1
Workbooks.Open Filename:=AllFiles(test)
Next
ReDim AllFiles(count)
test = 2
Do While (test <= count)
Filename = AllFiles(test)
Workbooks(AllFiles(test)).Activate 'ERROR Brings 2nd file that the user had selected to Last xml file selected in order to Front
'Copy and Paste TMG tab
Sheets("TMG_4 0").Activate
StartRow = 2
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCell = Cells(LastRow, LastColumn).Address 'Find lastcell of to be copied file
Range("A2:" & LastCell).Select
Selection.Copy
Windows("Allfiles(1).xml").Activate 'ERROR
Sheets("TMG_4 0").Activate
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow = LastRow + 1
Range("LastRow").Select 'ERROR
ActiveSheet.Paste
'Copy and Paste Gamma tab
Sheets("GammaCPS 0").Activate
StartRow = 2
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCell = Cells(LastRow, LastColumn).Address
Range("A2:" & LastCell).Select
Selection.Copy
Windows("Allfiles(1).xml").Activate 'ERROR Windows("File_name.xlsm").activate
Sheets("GammaCPS 0").Activate
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow = LastRow + 1
Range("LastRow").Select 'ERROR
ActiveSheet.Paste
test = test + 1
Loop
Windows("Allfiles(1).xml").Activate 'ERROR
ActiveWorkbook.SaveAs Filename:="C:\" & AllFiles(1) & AllFiles(test) & ".xlsm", FileFormat:=52
End Sub
For looping through an array, try this:
For test = 1 to ubound(AllFiles) - 1 'This loops through the array from the second element to the last
Is "LastRow" a named range? If not, that's not going to work. The following will select the last used row in a worksheet:
activesheet.Rows(activesheet.usedrange.rows.count).select
Your SaveAs is failing because 1) AllFiles looks like it's never filled and 2) your save path as you wrote would be literally:
C:\Allfile(1)&Allfiles(count)\.xlsm
. You want:ActiveWorkbook.SaveAs Filename:= "C:\" & AllFiles(1) & AllFiles(test) & ".xlsm"
EDIT After Code Update
You never initialize your count variable, add
count = 0
to the beginning just to be safe.GetOpenFilename
does in fact return the full path. Once you have that path stored in a variable (such as AllFiles()) you can get just the filename portion withmid(AllFiles(test), instrrev(AllFiles(test), "\") + 1)
You don't need the
ReDim AllFiles(count)
prior to your main Do Loop. ReDim erases the contents of the array unless you use the Preserve keyword.Change
Workbooks(AllFiles(test)).Activate
toWorkbooks(Mid(AllFiles(test), InStrRev(AllFiles(test), "\") + 1)).Activate
to strip the path information and leave just the filename.Windows("Allfiles(1).xml").Activate
won't work since your sending a literal string. You wantWORKBOOKS(Mid(AllFiles(1), InStrRev(AllFiles(1), "\") + 1)).Activate
here again.LastRow = LastRow + 1
probably isn't what you meant. TrySet LastRow = LastRow.Offset(1, 0)
Change
Range("LastRow").Select
toLastRow.select
All instances of
Windows(
should be changed toWorkbooks(