Copy values from multiple sheets
One more thought. You use column A to find the last row, but your data is in
column C - is there data in column A that will properly indicate the last
row. Perhaps use column C instead:
Assume Bridge is the sheet with the list of sheet names
Names are in column C starting in row 14
Add the code to set your format if appropriate
Sub ABC()
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim rng As Range, cell As Range
Dim rng1 As Range
Set sh = Worksheets("Bridge")
Set rng = sh.Range(sh.Cells(14, "C"), _
sh.Cells(sh.Rows.Count, "C").End(xlUp))
For Each cell In rng
Set sh1 = Worksheets(sh.Cells(cell.Row, "C").Text)
Set rng1 = sh1.Cells.Find(What:="", _
After:=sh.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
If rng1 Is Nothing Then
MsgBox "Nothing found in Sheet " & sh1.Name
Else
rng1.Copy sh.Cells(cell.Row, 12)
MsgBox rng1.Address(0, 0, xlA1, True) & " copied"
End If
Next cell
End Sub
--
Regards,
Tom Ogilvy
"Tom Ogilvy" wrote in message
...
Assume Bridge is the sheet with the list of sheet names
Names are in column C starting in row 14
Add the code to set your format if appropriate
Sub ABC()
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim rng As Range, cell As Range
Dim rng1 As Range
Set sh = Worksheets("Bridge")
Set rng = sh.Range(sh.Cells(14, "A"), _
sh.Cells(sh.Rows.Count, "A").End(xlUp))
For Each cell In rng
Set sh1 = Worksheets(sh.Cells(cell.Row, "C").Text)
Set rng1 = sh1.Cells.Find(What:="", _
After:=sh.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
If rng1 Is Nothing Then
MsgBox "Nothing found in Sheet " & sh1.Name
Else
rng1.Copy sh.Cells(cell.Row, 12)
MsgBox rng1.Address(0, 0, xlA1, True) & " copied"
End If
Next cell
End Sub
--
Regards,
Tom Ogilvy
wrote in message
oups.com...
Well, then I give up. First I commented out the
Application.ScreenUpdating=False line, then I tried changing it to
Application.ScreenUpdating=True and putting it back into the mix. No
matter what I do nothing happens. It doesn't switch sheets, it doesn't
raise an error, it just sits there. I certainly don't know what I'm
missing, but it's obviously not going to work on this computer.
Thanks for all of your time.
Melinda
Tom Ogilvy wrote:
Sheets(Cells(jRow, 3).Text).Activate
causes it to select another sheet.
IF you turned on screenupdating, it should select a sheet or raise an
error.
--
Regards,
Tom Ogilvy
wrote in message
oups.com...
Hi Tom,
Thanks for the feedback. I had set up my search function by recording
a manual find, but had just used the format button and set the font
style to bold, which wasn't recorded in vb. So, now I have the font
style set (I think), but still nothing. When I run it, it doesn't go
to the proper sheet to be able to copy cell. It just sits there. Any
more ideas? I'm starting to feel rather silly for not being able to
get this to work.
Dim jRow As Long
For jRow = 14 To Cells(Rows.Count, "A").End(xlUp).Row
Sheets(Cells(jRow, 3).Text).Activate
Range("C14").Select
Application.FindFormat.Font.FontStyle = "Bold"
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False, SearchFormat:=True).Activate
Selection.Copy
Sheets("BRIDGE").Select
Cells(jRow, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Next jRow
Thanks!
Melinda
Tom Ogilvy wrote:
I assumed when you said it worked for one item, that you had that set
correctly.
Turn on the macro recorder, then manually do a search and specify a
format
(it will ask you to select a sample cell). Turn off the macro
recorder.
Look at the recorded code.
You will see that you have to set the format to search for.
I believe you can eliminate any of the recorded settings that you are
not
interested in, but you will have to test to make sure.
--
Regards,
Tom Ogilvy
" wrote:
Never mind on jrow=0 thing. One of my other macros that works
shows a
similar variable as being equal to 0. However, I'm still stumped.
How
does the search function know to look for bold cells?
Cells.Find(What:="", After:=Range("C14"), LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False, SearchFormat:=True).Activate
I see that it says SearchFormat:=True, but how does it determine
the
format?
I'm wondering if this isn't the problem.
wrote:
I turned on screenupdating and it's not doing anything. It's
just
sitting there. I don't know why it insists that jrow is equal to
0,
but that would explain why it doesn't do anything. It's all very
odd.
I checked the sheets that the macro should be going to to copy,
and
there are no blank cells formatted as bold.
Any more ideas?
Thank you so much for your time!
Melinda
Tom Ogilvy wrote:
you have
for jrow = 14 to Cells(Rows.Count, "A").End(xlUp).Row
if the activesheet has values in row 14 and below (14), I
don't
see how
jrow could have a value of zero.
Your code looks OK to me unless you have blank cells that are
formatted as
bold.
Why not leave screenupdating turned on and see what your macro
is
doing.
--
Regards,
Tom Ogilvy
"Melinda" wrote in message
...
Hi Tom,
I changed the cell reference, and now the macro runs, but it
pastes no
values. I'm sure I'm missing something easy. If I step into
the
macro
and
hover my cursor over Cells(jRow,12).Select, it shows jRow=0,
instead of a
value in my range.
Any more ideas?
Thanks a lot!
Melinda
"Tom Ogilvy" wrote:
Range(Cells(jRow, 12)).Select
should be
Cells(jRow, 12).Select
--
Regards,
Tom Ogilvy
"Melinda" wrote:
Hello,
I'm having trouble copying values from multiple worksheets
into my
summary
sheet. What I need to do is, look at the value in column
C,
go to the
worksheet with that name, find the bold cell, copy that
value
and paste
it
back in column L of the first sheet. I can do this for
one
cell, but
how do
I repeat it for each row in my summary table?
Below is my attempt at code. Any thoughts?
Sub FindBold()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Rng As Range
Dim jRow As Long
For jRow = 14 To Cells(Rows.Count, "A").End(xlUp).Row
Worksheets(Range(Cells(jRow, 3)).Text).Activate
Cells.Find(What:="", After:=Range("C14"),
LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext,
MatchCase:=False, SearchFormat:=True).Activate
Selection.Copy
Sheets("BRIDGE").Select
Range(Cells(jRow, 12)).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Next jRow
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
|