Я оригинальный постер. Извиняюсь за то, что не публикую в соответствии с обычной практикой. Я нашел код, похожий на тот, который мне нужен, в ответе на достаточно похожий запрос. Я адаптировал это к тому, что мне было нужно:
Sub MoreAndMoreSheets()
Dim ListSh As Worksheet, BaseSh As Worksheet
Dim NewSh As Worksheet
Dim ListOfNames As Range, LRow As Long, cell As Range
With ThisWorkbook
Set ListSh = .Sheets("List")
Set BaseSh = .Sheets("Base")
End With
LRow = ListSh.Cells(Rows.Count, "A").End(xlUp).Row '--Get last row of list.
Set ListOfNames = ListSh.Range("A6:A" & LRow) '--Qualify our list.
With Application
.ScreenUpdating = False '--Turn off flicker.
.Calculation = xlCalculationManual '--Turn off calculations.
End With
For Each cell In ListOfNames '--For every name in list...
BaseSh.Copy After:=Sheets(Sheets.Count) '--Copy Base sheet.
Set NewSh = ActiveSheet '--Let's name it NewSh.
With NewSh
On Error GoTo Boom '--In case of errors.
.Name = cell.Value '--Set the sheet's name to that of our current name in list.
GoTo LetUsContinue '--Skip to the LetUsContinue block.
Boom: '--In case of duplicate names...
.Name = "Dup" & cell.Value '--Add "Dup" to beginning.
.Tab.ColorIndex = 53 '--Change the tab color of the duplicate tab to orange for easy ID.
LetUsContinue:
On Error GoTo 0 '--Turn off error handling.
.Range("A1") = cell.Value
.Calculate '--Calculate page.
End With
Next cell
With Application
.ScreenUpdating = True '--Return to proper state.
.Calculation = xlCalculationAutomatic '--Return to automatic calculation.
End With
BaseSh.Activate '--Select Base.
MsgBox "Done!" '--Done!
End Sub
Я использовал vlookup, ссылающийся на лист списка в ячейке B1 Базового листа, который выполнил то, что я хотел, в отношении второго столбца, проходящего через:
= ВПР (A1, 'Список'!A6:B500,2, FALSE)
Благодаря TheLaughingMan, должен ли он когда-либо прочесть это, так как он был кодом, который я адаптировал.