Копирование ячеек на листы

[staniiislav]

Здравствуйте Ув. форумчане.
У меня есть очень маленькая проблема в составлении макроса, который будет копировать ячейки с листа1 на все остальные листы.
на листе 1 нужно скопировать ячейки B3:E20 и вставить на ВСЕ остальные листы (предварительно сняв защиту листа, после копирования назад поставив защиту листа) в ячейки I3:K20.
Буду благодарен за помощь.
Заранее большое спасибо
Вот примерчик

[IgorGO]

Sub copyB3_E20()
  For Each sh In Sheets
    If sh.Name <> ActiveSheet.Name Then
      sh.Unprotect
      Range("B3:E20").Copy Destination:=sh.Range("I3")
      sh.Protect
    End If
  Next
End Sub

[staniiislav]

Сообщение от IgorGO

Sub copyB3_E20()
  For Each sh In Sheets
    If sh.Name <> ActiveSheet.Name Then
      sh.Unprotect
      Range("B3:E20").Copy Destination:=sh.Range("I3")
      sh.Protect
    End If
  Next
End Sub

Спасибо большое IgorGO, за-то, что откликнулись, вот сейчас тоже собирал кодик один, посмотрите пожалуйста, нормальный?:

Sub copy()

Const MyPassword = "111" 
Dim i%
For i = 1 To ThisWorkbook.Sheets.Count
Sheets(1).Range("O3:P24").Copy
  With Sheets(i).Range("DM9:DN30")


    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         'Sheets(i).Columns("DM:DN").ColumnWidth = 15
   Range("A1").Select
     With Sheets(i)
        .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
            AllowFiltering:=True, UserInterfaceOnly:=True
            .EnableOutlining = True
           
     End With
  End With
Application.CutCopyMode = False
Next
Sheets(1).Range("A1").Select
End Sub

только маленький нюанс, (выделено красным), при переходе на любой из листов, в которые проводилось копирование, не могу доделать чтобы открывался лист на на определенной ячейки. Не подскажите как этот нюанс доделать? И подскажите какой лучше взять код, Ваш или то что я насобирал )))

[staniiislav]

Sub Copy()

Const MyPassword = "111" 
Dim i%
For i = 1 To ThisWorkbook.Sheets.Count
Sheets(1).Range("O3:P24").Copy
  With Sheets(i).Range("DM9:DN30")


    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         'Sheets(i).Columns("DM:DN").ColumnWidth = 15
   Range("A1").Select
     With Sheets(i)
        .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
            AllowFiltering:=True, UserInterfaceOnly:=True
            .EnableOutlining = True
           
     End With
  End With
Application.CutCopyMode = False
Next
Sheets(1).Range("A1").Select
End Sub

[kuklp]

Сообщение от IgorGO

For Each sh In Sheets
[/CODE]

Игорь, я бы написал:

For Each sh In thisworkbook.workSheets

Мало ли, листы диаграмм, форм, другая книга открыта и т.д. Ничего, что я по англицки?

[kuklp]

Сообщение от staniiislav

Sub Copy()

Const MyPassword = "111" 
Dim i%
For i = 1 To ThisWorkbook.Sheets.Count
Sheets(1).Range("O3:P24").Copy
  ...
End Sub

Лучше:

Sub MyCopy()
Const MyPassword = "111"
Dim i%
For i = 1 To ThisWorkbook.Worksheets.Count
 If Sheets(i).Name <> ActiveSheet.Name Then
Sheets(i).Range("DM9:DN30").Value = Sheets(1).Range("O3:P24").Value
     With Sheets(i)
        .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
            AllowFiltering:=True, UserInterfaceOnly:=True
            .EnableOutlining = True
     End With
  End If
Next
End Sub

И еще - не хотите проблем, не называйте макросы зарезервированными словами Экса(ВБА).

[staniiislav]

Сообщение от kuklp

Лучше:

Sub MyCopy()
Const MyPassword = "111"
Dim i%
For i = 1 To ThisWorkbook.Worksheets.Count
 If Sheets(i).Name <> ActiveSheet.Name Then
Sheets(i).Range("DM9:DN30").Value = Sheets(1).Range("O3:P24").Value
     With Sheets(i)
        .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
            AllowFiltering:=True, UserInterfaceOnly:=True
            .EnableOutlining = True
     End With
  End If
Next
End Sub

И еще - не хотите проблем, не называйте макросы зарезервированными словами Экса(ВБА).

большое спасибо с утра сижу мучаюсь! и за имена спасибо! буду знать.
Тему можно закрывать, вопросов больше нет.
отдельное спасибо kuklp и IgorGO
выручили!