Попробуй это:
Sub Macro1()
RowNum = InputBox("Enter Row Number where you want to add a row:", "What Row?")
If RowNum = "" Then Exit Sub
Range("A1").Offset(RowNum, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="London,Sydney"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Примечание. Большую часть этого я записал с помощью инструмента «Запись макроса» на вкладке «Разработчик», а затем отредактировал для использования частей вашего кода. Это полезный метод, когда вы не уверены, какой именно код требуется для вставки чего-либо, например, этот выпадающий список проверки.
Изменить: чтобы добавить два списка одновременно:
Sub Macro1()
'ask user for row to insert data
RowNum = InputBox("Enter Row Number where you want to add a row:", "What Row?")
If RowNum = "" Then Exit Sub
'insert dropdowns in column A
Range("A1").Offset(RowNum, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="London,Sydney"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'inset second drop down in column E
Range("E1").Offset(RowNum, 0).Select '<-- change reference to E
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '<-- line removed as don't need to insert twice
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="New York,Jakarta"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
и со многими идентичными списками:
Sub Macro1()
Dim RowNum As Integer
Dim Lists As Integer
'ask user for row to insert data
RowNum = InputBox("Enter Row Number where you want to add a row:", "What Row?")
'insert row
Range("A1").Offset(RowNum, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'ask how many drop down lists to make
Lists = InputBox("Enter number of drop down lists to make in this row:", "Number?")
i = 0
Do While i < Lists And i < 1000
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Hong Kong,Rome,Wellington,Cairo"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'move across one cell
ActiveCell.Offset(0, 1).Range("A1").Select
i = i + 1
Loop
End Sub