Copy Cell to Same Cell on Multiple Sheets

[Mike]

I am trying to copy a cell (A2) into the same cell across multiple sheets
(copy cell A2 in sheet1 to A2 in sheet2,sheet3, etc) Since I have bunch of
sheets, what macro would I need to write in order to accomplish this.


Thanks
Mike

 

[Norman Jones]

Hi Mike,

Try:
'==========>>
Public Sub aTest2()
Dim rng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim WS As Worksheet

Set WB = ActiveWorkbook '<<========== CHANGE
Set SH = WB.Sheets("Sheet1") '<<========== CHANGE
Set rng = SH.Range("A2") '<<========== CHANGE

For Each WS In WB.Worksheets
If WS.Name <> SH.Name Then
On Error Resume Next
rng.Copy WS.Range(rng.Address)
On Error GoTo 0
End If
Next

End Sub
'<<==========

 

[Guest]

Try group the sheets together before entering the value please

 

[Mike]

Norman,
That worked. Thanks. Is there a way to exclude certian sheets, lets say
sheet75 and sheet76?

Thanks
Mike

 

[Norman Jones]

Hi Mike,

And to copy the cellto specific sheets, rather than all worksheets, try:

'==========>>
Sub aTest3()
Dim rng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim WS As Worksheet
Dim arr As Variant

arr = Array("Sheet2", "Sheet3", "Sheet7") '<<===== CHANGE

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE
Set rng = SH.Range("A1") '<<===== CHANGE

For Each WS In WB.Worksheets
If Not IsError(Application.Match(WS.Name, arr, 0)) Then
On Error Resume Next
rng.Copy WS.Range(rng.Address)
On Error GoTo 0
End If
Next

End Sub
'<<==========

 

[Norman Jones]

Hi Mike,

Yes, see the second version I posted.

 

[Mike]

Norman,
Is there away to specify which sheets to exclude since there would too many
sheets to type to include.

Thanks Again - this is really helpful
Mike