Unbealiveble, здравствуйте
[vba]Код
Sub Добавить_новый_проект()
Dim bFlag As Boolean
Dim oRng As Range
Dim oSh As Worksheet
With Application: .ScreenUpdating = False: .EnableEvents = False
With ThisWorkbook
For Each oRng In .Worksheets("Список_проектов").Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each oSh In .Worksheets
If oSh.Name = oRng.Value Then bFlag = True: Exit For
Next oSh
If Not (bFlag Or oRng.Value = "") Then
.Worksheets("Шаблон").Copy After:=.Worksheets("Список_проектов")
.Worksheets(.Worksheets("Список_проектов").Index + 1).Name = oRng.Value
.Worksheets(oRng.Value).Visible = True
End If
bFlag = False
Next oRng
.Worksheets("Список_проектов").Activate
End With
.ScreenUpdating = True: .EnableEvents = True: End With
End Sub
[/vba]