Добро пожаловать на StackOverflow, Илья!
На самом деле это не очень сложная задача. Её можно разбить на четыре простых фрагмента:
- перебрать ячейки диапазона по одной;
- отыскать значение ячейки в другом листе той же книги
- убедиться, что такой лист ещё не создан
- добавить лист в книгу
Собрать всё это вместе не намного труднее, чем сложить конструктор Лего:
Sub CreateSheetsForDoubles()
Dim aRange1 As Range, aRange2 As Range ' Диапазоны ячеек с именами - первый и второй список
Dim oCell As Range ' Одна ячейка, чтобы перебрать каждую из ячеек в первом диапазоне
Dim sNextName As String ' Текст из ячейки oCell
Dim vResOfMatch As Variant ' Результат поиска sNextName во втором списке - или номер строки, или ошибка
Dim sRes As String ' Текст финального сообщения - имена созданых листов
Dim ws As Worksheet ' Переменная для проверки "лист с таким именем уже существует?"
Dim sheet As Worksheet ' Переменная для новых листов
Set aRange1 = [Лист1!A1:A10] ' Диапазоны можно задать так...
Set aRange2 = Worksheets("Лист2").Range("A1:A10") ' ...или так. Или спросить в диалоге
For Each oCell In aRange1 ' Для каждой ячейки в первом списке
sNextName = Trim(oCell.Text) ' Взять её текстовое представление без оконечных пробелов
If sNextName <> vbNullString Then ' Если текст в ячейке есть (если она не пустая)
vResOfMatch = Application.Match(sNextName, aRange2, 0) ' Попытаться отыскать это значение во втором списке
If Not IsError(vResOfMatch) Then ' Если не ошибка, значит во втором списке это имя есть
Set ws = Nothing ' Проверить, нет ли уже листа с таким именем (в случае, если макрос запускается повторно)
On Error Resume Next
Set ws = Worksheets(sNextName)
On Error GoTo 0
If ws Is Nothing Then ' Нет, в єтой книге листа с таким именем нет
If Len(sRes) > 0 Then sRes = sRes & ", " ' Дополнить список найденных имён
sRes = sRes & sNextName
Rem Создать лист, присвоить ему имя и вписать в первую ячейку то же самое имя
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
sheet.Name = sNextName
sheet.[A1].Value = sNextName
End If
End If
End If
Next oCell
Rem В конце сообщить о результатах выполнения макроса
If Len(sRes) = 0 Then
Call MsgBox("Нет имен для новых листов")
Else
Call MsgBox("Созданы листы для " & sRes)
End If
End Sub
Надеюсь, это поможет удачно стартовать в программировании. Успехов!