J
justme
HI,
I have put a macro together from browsing the posts.
I have a template that has 3 sheets. The information on sheet2 ("INTL")
actually comes from one sheet each in 6 other workbooks that are regularly
updated on our server, from which I am copying and pasting into my new
template, one below the other in the same columns.
I am trying to create a new macro to automate that process
So, I'd like my routine when I receive a new batch of files to be that I:
1) open a new blank workbook from the template "Blend"
2) I will save the blank workbook to a name like 061210_input
3) Then I will run my macro from the new workbook.
The macro will:
1) Prompt me to open a file to get the data from
2) copy All data in columns A through J on sheet 2 of that file, no matter
what the sheet is named (there may be intermittent blank rows, but I need
all data in those columns. Column data may have blanks. Column I is most
dependable to have data)
3) paste it into columns A through J of the newly saved "blend" workbook
sheet2 (named "INTL")
4) Leave both workbooks open without saving
5) Set the destination file as the active workbook again
6) Prompt me for the next file to copy from
5) Copy columns A through J on sheet 2 of that file
8) find the first blank row on sheet "INTL" after last data and paste
directly below it into columns A-J.
9) prompt me for the next file name and so on until all the files, at which
time I'll cancel the open dialog.
I have been hacking at this macro for awhile I just found this code on
another post from Mike, but not I'm kinda clueless.
Please help!
Sub consolidate()
Dim origin As String
Dim orgn As Workbook, dest As Workbook
Dim Blended as Workbook
Dim WSI as Worksheet
Set blended = ActiveSheet
Set wsI = Blended.Sheets("INTL")
Do
Application.ScreenUpdating = False
origin = Application.GetOpenFilename("Microsoft Office Excel Files
(*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw")
If origin = "False" Then Exit Sub
Workbooks.Open origin, 0, True
Set orgn = ActiveWorkbook
If ThisWorkbook.ReadOnly Then
MsgBox ("The destination file has been opened as a Read-Only file and
cannot be written to...Cancelling")
End If
Dim LastRow As Long
orgn.Activate
With orgn.sheets(2)
LastRow = orgn.sheets(2).Cells(Rows.Count, "I").End(xlUp).Row
Set MyRange = wsI.Cells(LastRow, "I").Offset(1, -8)
..Range("A1", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=MyRange.PasteSpecial(xlPasteValues)
End With
wsI.Activate
Loop
End Sub
Thanx!!!!!!
I have put a macro together from browsing the posts.
I have a template that has 3 sheets. The information on sheet2 ("INTL")
actually comes from one sheet each in 6 other workbooks that are regularly
updated on our server, from which I am copying and pasting into my new
template, one below the other in the same columns.
I am trying to create a new macro to automate that process
So, I'd like my routine when I receive a new batch of files to be that I:
1) open a new blank workbook from the template "Blend"
2) I will save the blank workbook to a name like 061210_input
3) Then I will run my macro from the new workbook.
The macro will:
1) Prompt me to open a file to get the data from
2) copy All data in columns A through J on sheet 2 of that file, no matter
what the sheet is named (there may be intermittent blank rows, but I need
all data in those columns. Column data may have blanks. Column I is most
dependable to have data)
3) paste it into columns A through J of the newly saved "blend" workbook
sheet2 (named "INTL")
4) Leave both workbooks open without saving
5) Set the destination file as the active workbook again
6) Prompt me for the next file to copy from
5) Copy columns A through J on sheet 2 of that file
8) find the first blank row on sheet "INTL" after last data and paste
directly below it into columns A-J.
9) prompt me for the next file name and so on until all the files, at which
time I'll cancel the open dialog.
I have been hacking at this macro for awhile I just found this code on
another post from Mike, but not I'm kinda clueless.
Please help!
Sub consolidate()
Dim origin As String
Dim orgn As Workbook, dest As Workbook
Dim Blended as Workbook
Dim WSI as Worksheet
Set blended = ActiveSheet
Set wsI = Blended.Sheets("INTL")
Do
Application.ScreenUpdating = False
origin = Application.GetOpenFilename("Microsoft Office Excel Files
(*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw")
If origin = "False" Then Exit Sub
Workbooks.Open origin, 0, True
Set orgn = ActiveWorkbook
If ThisWorkbook.ReadOnly Then
MsgBox ("The destination file has been opened as a Read-Only file and
cannot be written to...Cancelling")
End If
Dim LastRow As Long
orgn.Activate
With orgn.sheets(2)
LastRow = orgn.sheets(2).Cells(Rows.Count, "I").End(xlUp).Row
Set MyRange = wsI.Cells(LastRow, "I").Offset(1, -8)
..Range("A1", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=MyRange.PasteSpecial(xlPasteValues)
End With
wsI.Activate
Loop
End Sub
Thanx!!!!!!