Copy values from multiple sheets

[Guest]

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

 

[Guest]

Range(Cells(jRow, 12)).Select
should be

Cells(jRow, 12).Select

 

[Guest]

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]

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.

 

[melinda.chase]

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

 

[melinda.chase]

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.

 

[Guest]

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.

 

[melinda.chase]

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]

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.

 

[melinda.chase]

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]

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

 

[Tom Ogilvy]

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

 

[melinda.chase]

Tom,
Thank you!!!!! I changed my jRow to look at column C, and it worked.
Boy do I feel silly. It never occured to me that since column A was
empty, it wouldn't count anything. I assumed that it would just go
down the sheet to what I considered the end.
It's up and running now!
Thanks again!
Melinda