работа макроса для каждого листа

[DMITRIY_78]

Ребята Здравствуйте! подсобите с таким вопросом, есть макрос:

Private Sub Worksheet_Change(ByVal Target As Range)
Set p = Sheets("db").Range("Изделие1")
    If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("G3:G1000")) Is Nothing Then
    If WorksheetFunction.CountIf(p, Target) = 0 Then
    r = MsgBox("Добавленно", vbYesNo)
    If r = vbYes Then p.Cells(p.Rows.Count + 1) = Target
End If
End If
End Sub

вопрос: дабы не плодить его на каждом листе (пробовал в модуль занести не работает) может что то дописать что бы работал из модуля этот макрос? Заранее спасибо!

[o5a]

Заменить Private на Public.

[DMITRIY_78]

o5a, выдал ошибку на строку

If Target.Cells.Count > 1 Then Exit Sub

вынес ее на лист

Worksheet_Change

ни чего не поменялось что публично что без нее (пробовал) выдает те же ошибки

[o5a]

Насколько мне известно процедуры типа Worksheet_Change пишутся только в модулях листов поскольку вызываются как реакция на событие на конкретном листе, здесь - на изменение ячеек. Можно содержимое вынести в отдельную процедуру и её вызывать из Worksheet_Change...

[DMITRIY_78]

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

вынести в отдельную

можно на примере показать?

[IgorGO]

в модуль ЭтаКнига одну процедуру (чтобы не плодить)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   ...
End Sub

[DMITRIY_78]

IgorGO, правильно ли я понимаю в таком случает этот код

  If Not Intersect(Target, Range("G3:G1000")) Is Nothing Then

будет распростроняться на все листы в книге?

[IgorGO]

Target - для всех
Range("G3:G1000") - для активного
а просто попробовать что получится вам религия не позволяет?

[DMITRIY_78]

IgorGO, принято, СПАСИБО!

[DMITRIY_78]

Для чайников! таких как я

Public Static Function список(ByVal Target As Range)
Set Sh = ThisWorkbook.Worksheets("db")
Set p = Sh.Range("Изделие1")
    If Target.Cells.Count > 1 Then Exit Function
    If IsEmpty(Target) Then Exit Function
    If Not Intersect(Target, Range("G3:G1000")) Is Nothing Then
    If WorksheetFunction.CountIf(p, Target) = 0 Then
    r = MsgBox("Добавленно: " & Target, vbInformation + vbYesNo, "ÈИнформация")
    If r = vbYes Then p.Cells(p.Rows.Count + 1) = Target
End If
End If
End Function

вызвал ее

Run список(ByVal Target)