T
thompsonf
I have written a macro trying to copy worksheets("Upload") from
multiple workbooks to a single Worksheets("MasterUpload") in a Master
Workbooks("MasterUpload.XLS"). During the While loop, the desired
copying range will be appended to the MasterUpload sheet one by one.
However, I have encountered problems in the stability of the macro as
some of the workbooks content doesn't seem to have pasted into the
MasterUpload.
Does anyone have a more stable method of copying and appending into a
single workbook? Cheers.
*********************
Sub BuildMasterUpload()
Dim i, X, Y, iRow, Col, Mrow As Integer
Dim A(1 To 26) As String
Application.ScreenUpdating = False
'/Please this A to Z file name accordingly before running this
Macro
A(1) = "Plan1.xls"
A(2) = "Active1.xls"
A(3) = "Deactive1.xls"
A(4) = "Brilliant.xls"
A(5) = "Central.xls"
A(6) = "London.xls"
A(7) = "Paris.xls"
A(8) = "New York.xls"
A(9) = "Milan.xls"
A(10) = "Tokyo.xls"
Workbooks("MasterUpload.XLS").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
Workbooks(A(1)).Activate
Application.CutCopyMode = True
Workbooks(A(1)).Worksheets("Upload").UsedRange.Copy
Workbooks("MasterUpload.XLS").Activate
Range("A65536").Select
Selection.End(xlUp).Select
Workbooks("MasterUpload.XLS").Worksheets("MasterUpload").Cells(1,
1).PasteSpecial Paste:=xlValues
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Workbooks(A(1)).Close SaveChanges:=False
i = 2
While Len(A(i)) > 0
On Error Resume Next
Workbooks(A(i)).Activate
Worksheets("Upload").Range("A1").Select
If Err.Number > 0 Then
Else
Application.CutCopyMode = True
iRow = Cells(65536, 1).End(xlUp).Row
Workbooks(A(i)).Worksheets("Upload").Range(Cells(2, 1),
Cells(iRow, 24)).Select
Selection.Copy
Workbooks("MasterUpload.XLS").Activate
Mrow = Cells(65536, 1).End(xlUp).Row
Workbooks("MasterUpload.XLS").Worksheets("MasterUpload").Cells(Mrow
+ 1, 1).PasteSpecial Paste:=xlValues
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Workbooks(A(i)).Close SaveChanges:=False
End If
iRow = 0
i = i + 1
Wend
End Sub
******************************
multiple workbooks to a single Worksheets("MasterUpload") in a Master
Workbooks("MasterUpload.XLS"). During the While loop, the desired
copying range will be appended to the MasterUpload sheet one by one.
However, I have encountered problems in the stability of the macro as
some of the workbooks content doesn't seem to have pasted into the
MasterUpload.
Does anyone have a more stable method of copying and appending into a
single workbook? Cheers.
*********************
Sub BuildMasterUpload()
Dim i, X, Y, iRow, Col, Mrow As Integer
Dim A(1 To 26) As String
Application.ScreenUpdating = False
'/Please this A to Z file name accordingly before running this
Macro
A(1) = "Plan1.xls"
A(2) = "Active1.xls"
A(3) = "Deactive1.xls"
A(4) = "Brilliant.xls"
A(5) = "Central.xls"
A(6) = "London.xls"
A(7) = "Paris.xls"
A(8) = "New York.xls"
A(9) = "Milan.xls"
A(10) = "Tokyo.xls"
Workbooks("MasterUpload.XLS").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
Workbooks(A(1)).Activate
Application.CutCopyMode = True
Workbooks(A(1)).Worksheets("Upload").UsedRange.Copy
Workbooks("MasterUpload.XLS").Activate
Range("A65536").Select
Selection.End(xlUp).Select
Workbooks("MasterUpload.XLS").Worksheets("MasterUpload").Cells(1,
1).PasteSpecial Paste:=xlValues
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Workbooks(A(1)).Close SaveChanges:=False
i = 2
While Len(A(i)) > 0
On Error Resume Next
Workbooks(A(i)).Activate
Worksheets("Upload").Range("A1").Select
If Err.Number > 0 Then
Else
Application.CutCopyMode = True
iRow = Cells(65536, 1).End(xlUp).Row
Workbooks(A(i)).Worksheets("Upload").Range(Cells(2, 1),
Cells(iRow, 24)).Select
Selection.Copy
Workbooks("MasterUpload.XLS").Activate
Mrow = Cells(65536, 1).End(xlUp).Row
Workbooks("MasterUpload.XLS").Worksheets("MasterUpload").Cells(Mrow
+ 1, 1).PasteSpecial Paste:=xlValues
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Workbooks(A(i)).Close SaveChanges:=False
End If
iRow = 0
i = i + 1
Wend
End Sub
******************************