Runtime error "1004" on this code, help pls

[azu_daioh]

I have this code:
Private Sub RollUP_Click()


Dim newRng As Range
Dim newWs As Worksheet


Set newWs = Worksheets("ROLLUP")
Set newRng = newWs.Range("B:B")

For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name <> newWs.Name Then

Sh.Range("G:G").Copy
newRng.PasteSpecial xlPasteValues
newRng.PasteSpecial xlPasteFormats

Sh.Range("lblWTotal").Value = Sh.Name
Set newRng = newRng.Offset(0, 1)
End If
Next

Application.ScreenUpdating = False
Worksheets("ROLLUP").Columns("B").Hidden = True
Application.ScreenUpdating = True

End Sub

--------
and each time I run it, I get the 1004 error message on this code
Sh.Range("lblWTotal").Value = Sh.Name

What I'm trying to accomplish is to change the value of a merged cell
named "lblWTotal" from each worksheet to the name of the worksheet
(ie. 205, 206, 207, 208, etc).

Thanks for your help.

 

[Jim Thomlinson]

I suspecty that you do not have a range named lblWTotal locally defined on
each sheet in your workbook. give this code a try...

Private Sub RollUP_Click()


Dim newRng As Range
Dim newWs As Worksheet
Dim rng as Range


Set newWs = Worksheets("ROLLUP")
Set newRng = newWs.Range("B:B")

For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name <> newWs.Name Then

Sh.Range("G:G").Copy
newRng.PasteSpecial xlPasteValues
newRng.PasteSpecial xlPasteFormats

set rng = nothing
On error resume next
set rng = Sh.Range("lblWTotal")
On error goto 0
if rng is nothing then
msgbox "Sheet " & sh.name & " does not contain lblWTotal"
else
Sh.Range("lblWTotal").Value = Sh.Name
end if
Set newRng = newRng.Offset(0, 1)
End If
Next

Application.ScreenUpdating = False
Worksheets("ROLLUP").Columns("B").Hidden = True
Application.ScreenUpdating = True

End Sub

 

[azu_daioh]

Thanks Jim. I now realized what went wrong. You were right, not all
my worksheets contain "lblWTotal" and I forgot to exclude them in the
If statement.


Thanks for the fast response. Now I can move on to the next
problem.