P
pil123
Very new to VBA, so please excuse the "sloppy" code. I am trying to find a
way of copying-pasting a specified range from several worksheets in one
workbook to one worksheet in a different workbook. I have been able to do
this by using specified names, but am looking to automate it a bit further so
that the names of the worksheets and workbooks can be plugged in
automatically (a "for" loop maybe?).
This is the code I have so far:
_______________________________
Sub copy_paste()
'activate "master" workbook
Application.Workbooks("master.xlsx").Activate
'activate "first_ws" worksheet
Application.Worksheets("first_ws").Select
' Finds the first cell that has the string "CUSTOMER:"
ActiveSheet.Cells.Find(What:="CUSTOMER:", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False).Select
'Set the Title Cell
TitleRw = ActiveCell.Row
TitleStrt = ActiveCell.Column
'This section identifies the final column of data that has information
TitleEnd = ActiveCell.EntireRow.SpecialCells(xlCellTypeLastCell).Column
'Sets the first cell of Information
FstCell = TitleRw + 1
'This section identifies the final row of data that has information
ActiveCell.EntireColumn.Select
'define new variable for the row and column of the lower right
LstCellRw = ActiveCell(ActiveCell.Parent.Rows.Count).End(xlUp).Row
'now we need something to identify the column for the final row
'Define new DIM LstCellCol as integer
LstCellCol = ActiveCell.EntireRow.SpecialCells(xlCellTypeLastCell).Column
'Section will set a new range for the upper left and
'lower right using the same code as the above for TitleRng
'Define new DIM CopyRng as Range
Set CopyRng = Range(Cells(FstCell, TitleStrt), Cells(LstCellRw, LstCellCol))
'copy & paste "first_ws" from "master.xlsx" to "slavexlsm"
CopyRng.Select
Selection.Copy
'activate "slave" workbook
Application.Workbooks("slave.xlsm").Activate
'select "slave_ws" worksheet
Application.Worksheets("slave_ws").Select
'next 2 lines look for text "master_ws1" in column B and offsets 1 row down
and 3 columns to the right
'and selects cell for pasting information
Set PasteRng = Range("B:B").Find("master_ws1", LookAt:=xlPart).Offset(1, 3)
PasteRng.Select
'for troubleshooting....should indicate the active cell for pasting
'MsgBox ActiveCell.Row
'range from "master.xsls" for "master_ws1" gets pasted on "slave_ws"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
_________________________________________
Any help would be greatly appreciated.
way of copying-pasting a specified range from several worksheets in one
workbook to one worksheet in a different workbook. I have been able to do
this by using specified names, but am looking to automate it a bit further so
that the names of the worksheets and workbooks can be plugged in
automatically (a "for" loop maybe?).
This is the code I have so far:
_______________________________
Sub copy_paste()
'activate "master" workbook
Application.Workbooks("master.xlsx").Activate
'activate "first_ws" worksheet
Application.Worksheets("first_ws").Select
' Finds the first cell that has the string "CUSTOMER:"
ActiveSheet.Cells.Find(What:="CUSTOMER:", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False).Select
'Set the Title Cell
TitleRw = ActiveCell.Row
TitleStrt = ActiveCell.Column
'This section identifies the final column of data that has information
TitleEnd = ActiveCell.EntireRow.SpecialCells(xlCellTypeLastCell).Column
'Sets the first cell of Information
FstCell = TitleRw + 1
'This section identifies the final row of data that has information
ActiveCell.EntireColumn.Select
'define new variable for the row and column of the lower right
LstCellRw = ActiveCell(ActiveCell.Parent.Rows.Count).End(xlUp).Row
'now we need something to identify the column for the final row
'Define new DIM LstCellCol as integer
LstCellCol = ActiveCell.EntireRow.SpecialCells(xlCellTypeLastCell).Column
'Section will set a new range for the upper left and
'lower right using the same code as the above for TitleRng
'Define new DIM CopyRng as Range
Set CopyRng = Range(Cells(FstCell, TitleStrt), Cells(LstCellRw, LstCellCol))
'copy & paste "first_ws" from "master.xlsx" to "slavexlsm"
CopyRng.Select
Selection.Copy
'activate "slave" workbook
Application.Workbooks("slave.xlsm").Activate
'select "slave_ws" worksheet
Application.Worksheets("slave_ws").Select
'next 2 lines look for text "master_ws1" in column B and offsets 1 row down
and 3 columns to the right
'and selects cell for pasting information
Set PasteRng = Range("B:B").Find("master_ws1", LookAt:=xlPart).Offset(1, 3)
PasteRng.Select
'for troubleshooting....should indicate the active cell for pasting
'MsgBox ActiveCell.Row
'range from "master.xsls" for "master_ws1" gets pasted on "slave_ws"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
_________________________________________
Any help would be greatly appreciated.