Прошу помочь, не ясно почем, но в какой то момент дописывания кода Диапазон перестал заполняться (файл во вложении). Должно работать: В диапазон "P41:AA70" по столбцам добавляется "Проверка данных", с разными источниками для проверки (источником является Список с формулой ссылающейся на динамический диапазон). Не заполняется, уже перепробовал указывать конкретные листы и прочее...
Код
Sub Zapolnit_ValidationLists()
Dim C1 As Long, C2 As Long, C1_2 As Long, i As Long
Dim xRange As Range
Dim L As String, L2 As String
Dim f1 As String, f2 As String
C1 = Columns("P").Column
C2 = Columns("AA").Column
C1_2 = Columns("E").Column
For i = C1 To C2
L = Columns(C1_2).Address
L2 = Left(L, (Len(L) - 1) / 2)
f1 = "=OFFSET(" & L2 & "$26,1,,IF(CountA(" & L2 & "$27:" & L2 & "$38)=0,1,CountA(" & L2 & "$27:" & L2 & "$38)))"
f2 = "=OFFSET($E$26,1,,IF(CountA($E$27:$E$38)=0,1,CountA($E$27:$E$38)))"
With ThisWorkbook.ActiveSheet
Set xRange = .Range(.Cells(i, 41), .Cells(i, 70))
With xRange.Validation
Debug.Print "Куда - " & Columns(i).Address & "; Откуда - " & L2 & " - " & f1 & "***" & C1_2
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=f1
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End With
C1_2 = C1_2 + 2
Next i
End Sub