mduff
03-29-2010, 12:03 PM
Hi,
I was looking on the internet and the board and just could not seem to get what I was looking for. :banghead:
I need to loop through any workbooks that are open (or even better browse to a folder) and extract the same cell from each book and paste it into a summary workbook. The summary workbook is the one with the code but will not be included in the loop. the cell will always be j5 and I would like to have the File name and J5 from the WS Score pasted in the summary book.
So the end summary WB looking like this
a1 b2
Book name Value of j5 from sheet Score
Thanks in advance and let me know if you have any questions
ub WBLoop()
Dim wbk As Workbook, rngToCopy As Range, rngToPaste As Range
With Worksheets("Score")
For Each wbk In Workbooks
' loop through the Open workbooks
If wbk.Name <> ThisWorkbook.Name Then
' exclude this workbook from the Loop
Set rngToPaste = .Range("A65536").End(xlUp).Offset(1, 0)
'set the target For the paste
Set rngToCopy = wbk.Range("J5")
'set the range To be copied
rngToCopy.Copy Destination:=rngToPaste
'do the copying
End If
Thanks in advance and let me know if you have any questions
I was looking on the internet and the board and just could not seem to get what I was looking for. :banghead:
I need to loop through any workbooks that are open (or even better browse to a folder) and extract the same cell from each book and paste it into a summary workbook. The summary workbook is the one with the code but will not be included in the loop. the cell will always be j5 and I would like to have the File name and J5 from the WS Score pasted in the summary book.
So the end summary WB looking like this
a1 b2
Book name Value of j5 from sheet Score
Thanks in advance and let me know if you have any questions
ub WBLoop()
Dim wbk As Workbook, rngToCopy As Range, rngToPaste As Range
With Worksheets("Score")
For Each wbk In Workbooks
' loop through the Open workbooks
If wbk.Name <> ThisWorkbook.Name Then
' exclude this workbook from the Loop
Set rngToPaste = .Range("A65536").End(xlUp).Offset(1, 0)
'set the target For the paste
Set rngToCopy = wbk.Range("J5")
'set the range To be copied
rngToCopy.Copy Destination:=rngToPaste
'do the copying
End If
Thanks in advance and let me know if you have any questions