Option Explicit

Public Sub setLiist()
Dim ws As Worksheet
Dim i As Integer, rowLast%
Dim odict As Object

Set ws = ThisWorkbook.Worksheets("Заполнить")
Do While True
i = i + 1
If ws.Cells(i, 3).Value = "ИТОГО" Then
rowLast = i - 1
Exit Do
End If
Loop
Set odict = CreateObject("Scripting.Dictionary")
odict.CompareMode = 1

For i = 1 To ThisWorkbook.Worksheets.Count
odict.Add ThisWorkbook.Worksheets(i).Name, 1
Next i

With ws
For i = 2 To rowLast
If .Cells(i, 3).Value <> "" Then
If Not odict.exists(.Cells(i, 3).Value) Then 'исключаем повторы
odict.Add .Cells(i, 3).Value, 1
Worksheets.Add.Name = .Cells(i, 3).Value
With ThisWorkbook.Worksheets(.Cells(i, 3).Value)
'
'здесь добавить код для заполнения листов
'
End With
Else
MsgBox "Найден повтор: " & .Cells(i, 3).Address, 48, "Повтор!"
Exit Sub
End If
End If
Next i
End With
End Sub