I need a macro to copy every 3rd cell in a worksheet and paste it into
all corresponding worksheets in another workbook. For Example I have a
worksheet will all companies and their rating. And another workbook
with each company as a sheet. I need to copy their rating and paste it
into their company sheet.
Any Help would be appreciated.


---
Message posted from http://www.ExcelForum.com/

Try something like this:
'Dimension variables
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet

'Get the book and sheet where the information is to be
copied from
Set wbSource = Excel.Workbooks.Open("C:\source.xls")
Set wsSource = wbSource.Sheets("Sheet1")

'Get the book where the information is to be copied to
Set wbTarget = Excel.Workbooks.Open("C:\target.xls")

'Loop through all of the sheets in the target book and
set the value equal to the value from the source book
For Each wsTarget In wbTarget.Sheets
'Set Row 3, Column 1 value in the target sheet equal
to Row 3, Column 1 in the source sheet
wsTarget.Cells(3, 1).Value = wsSource.Cells(3,
1).Value
'then you could repeat this for every 3rd cell by
manually typing in each 3rd cell:
wsTarget.Cells(6, 1).Value = wsSource.Cells(6,
1).Value
wsTarget.Cells(9, 1).Value = wsSource.Cells(9,
1).Value

'or come up with some routine to loop through the
cells, something like...
Dim i As Long
i = 3
While i < 21
wsTarget.Cells(i, 1).Value = wsSource.Cells(i,
1).Value
i = i + 3
Wend
Next

'Clean up variables
Set wsTarget = Nothing
Set wbTarget = Nothing
Set wsSource = Nothing
Set wbSource = Nothing


-----Original Message-----
I need a macro to copy every 3rd cell in a worksheet and
paste it into
all corresponding worksheets in another workbook. For
Example I have a
worksheet will all companies and their rating. And
another workbook
with each company as a sheet. I need to copy their
rating and paste it
into their company sheet.
Any Help would be appreciated.


---
Message posted from http://www.ExcelForum.com/

.

for i = 1 to 200 step 3
set rng = cells(i,1)
rng.EntireRow.copy Destination:=workbooks("Book2.xls") _
.worksheets(rng.Value).Cells(rows.count,1).End(xlu p)(2)
Next

--
Regards,
Tom Ogilvy

"sharon " wrote in message
...
I need a macro to copy every 3rd cell in a worksheet and paste it into
all corresponding worksheets in another workbook. For Example I have a
worksheet will all companies and their rating. And another workbook
with each company as a sheet. I need to copy their rating and paste it
into their company sheet.
Any Help would be appreciated.


---
Message posted from http://www.ExcelForum.com/