Выделение ячеек в соседних листах по циклу

[Oleg778]

Привет всем !

Не могу справится с макросом

1)Находясь на исх листе в активной ячейке - запомнить имя листа и адрес активной ячейки
2)Перебором в цикле на соседних листах активировать ячейки по одному и тоже адресу
3)Вернутся на запомненный лист в запомненную ячейку

Код макроса прилагаю - ни в какую не хочет выделять ячейки на соседних листах

Sub Проверка()
'запоминаем лист и адрес активной ячейки исх листа
sName = ThisWorkbook.ActiveSheet.Name
z = ActiveCell.Address(0, 0)
'MsgBox sName & z
'перебираем листы по циклу и в каждом активирум свою ячейку по одному адресу
Dim i As Long, s As String
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        With ThisWorkbook.Worksheets(i)
           'ThisWorkbook.Worksheets(i).Cells(4, 3).Value = ThisWorkbook.Worksheets(i).Cells(4, 3).Value
           'ThisWorkbook.Worksheets(i).Cells(4, 3).Value = 5
           'ThisWorkbook.Worksheets(i).Range(Cells(4, 3), Cells(4, 3)).Activate
           'Range(Cells(4, 3), Cells(4, 3)).Select
           
        End With
Next
'возвращаемся на запомненный лист в запомненную ячейку
Worksheets(sName).Range(z).Select
End Sub

[IgorGO]

Sub ActivateSameCells()
  Dim adr$, shN&, ws As Worksheet
  adr = ActiveCell.Address:  shN = ActiveSheet.Index
  For Each ws In Worksheets
    ws.Activate: Range(adr).Select
  Next
  Worksheets(shN).Activate
End Sub

[Oleg778]

вот так получилось

Sub Проверка()
'запоминаем лист и адрес активной ячейки исх листа
sName = ThisWorkbook.ActiveSheet.Name
z = ActiveCell.Address(0, 0)
'MsgBox sName & z
'перебираем листы по циклу и в каждом активирум свою ячейку по одному адресу
Dim i As Long, s As String
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        With ThisWorkbook.Worksheets(i)
            ThisWorkbook.Worksheets(i).Activate
            ThisWorkbook.Worksheets(i).Range(Cells(4, 3), Cells(4, 3)).Activate
        End With
Next
'возвращаемся на запомненный лист в запомненную ячейку
Worksheets(sName).Range(z).Select
End Sub

[pashulka]

Альтернативный вариант :

Private Sub Test()
    Worksheets.Select
    ActiveSheet.Select
End Sub

[Oleg778]

спасибо за ответы мой вариант не сработал как надо
подошли варианты от IgorGO и pashulka большое спасибо
а как сделать в варианте IgorGO
чтобы сохранился запомненный адрес и имя листа
а на остальных листах активировались ячейки D4
после этого переходим в исх сохраненный лист в сохраненную ячейку ?

Так не хочет возвращаться в исходную ячейку

Sub ActivateSameCells()
  Dim adr$, shN&, ws As Worksheet
  adr = ActiveCell.Address:  shN = ActiveSheet.Index
  For Each ws In Worksheets
    ws.Activate: Range("D4").Select
  Next
  Worksheets(shN).Activate
End Sub