автозапуск макроса при изменении ячейки и сортировка др. столбца

[clar]

Помогите, пожалуйста, очень нужно записать автозапуск макроса в Visual Basic при изменении в ячейках диапазона C18:C37. Есть таблица в столбце С вложен список, макрос по автосортировке этого столбца по алфавиту работает (макрос2) , но не могу дополнить его автозапуском при изменении строк в этом столбце и еще нужна сортировка столбца В (В18:В37) , увязанная с сортировкой столбца С. В макросах новичок, получилось следующее:
Sub макрос2()
Range("C18:C37").Select
ActiveWorkbook.Worksheets("1д").Sort.sortfields.Clear
ActiveWorkbook.Worksheets("1д").Sort.sortfields.Add Key:=Range("C18"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("1д").Sort
.SetRange Range("C18:C37")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub макрос1()
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim rng As Range: Set rng = [C18:C37]
If Not Intersect(rng, Target) Is Nothing Then макрос2
Application.EnableEvents = True
End Sub

[pashulka]

Подведите курсор мышки к ярлычку нужного рабочего листа, кликните правой кнопкой мышки и в появившемся контекстном меню выберите команду Исходный текст, после чего скопируйте нижеприведённый код в модуль листа и сохраните изменения.

Код: Выделить всё

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   Dim iSource As Range
   Set iSource = Intersect(Range("C18:C37"), Target)
   If Not iSource Is Nothing Then
      Application.EnableEvents = False
      
      Range("B18:C37").Sort _
      Key1:=Range("C18"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      
      Application.EnableEvents = True
   End If
End Sub

[clar]

К сожалению, не могу макрос запустить, запрашивает имя. Если присваиваю, то пишет ошибку "Expected End Sub".

[clar]

Выдает ошибку 424 на строку
Set iSource = Intersect(Range("C18:C37"), Target)

[clar]

Спасибо, подскажите еще , пожалуйста, на одном листе макрос запускается на др. листе этой же книги - нет. Нужно, чтобы запустился на нескольких листах (например, лист1-10), а на листы 11-13 макрос не распространялся

[Naeel Maqsudov]

Тогда перенесите этот обработчик события из модуля листа в модуль книги. Там он должен выглядеть так:

Код: Выделить всё

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Dim iSource As Range
   Select Case Sh.Name
     Case "Лист1", "Лист2"
       Set iSource = Intersect(Range("C18:C37"), Target)
     Case "Лист5", "Лист6"
       Set iSource = Intersect(Range("E6:E22"), Target)
     Case Else
       Exit Sub
   End Select
   If Not iSource Is Nothing Then
      Application.EnableEvents = False
      Range("B18:C37").Sort _
      Key1:=Range("C18"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      Application.EnableEvents = True
   End If
End Sub

[clar]

Ура! Заработало

[pashulka]

От себя добавлю, что если существует вероятность переименования рабочих листов, где должна осуществляться сортировка, то Sh.Name можно заменить на Sh.CodeName и перечислить кодовые имена листов, которые, разумеется, могут отличаться от имён в семействе Worksheets

[Naeel Maqsudov]

А для совсем уж пущей юзабилити, можно добавить лист с настройками книги (возможно, скрытый), куда вынести список таких автосортируемых диапазонов, предусмотрев там еще и возможность указания параметров сортировки. Диапазон на том листе должен вводиться формулой, чтобы автоматически отслеживать, например, вставку строк и т.п.