Hallo Matthias,
damit es weitergeht:
 

Sub neuanlegen()
Dim zeile
  If Worksheets("Vorlage").Range("B1")="" then
    msgbox "Projektname leer!", vbCritical, "Projektnamen ändern"
    Exit Sub
  End If
  For Each zeile In ThisWorkbook.Sheets 'zeile ist hier temporär Sheet
    If zeile.Name = Worksheets("Vorlage").Range("B1") Then 'Test auf doppelten Namen
      MsgBox "Projektname existiert schon!", vbCritical, "Projektnamen ändern"
      Exit Sub
    End If
  Next zeile
  ActiveSheet.Copy after:=Sheets(Sheets.Count)
  zeile = Worksheets("Übersicht").Cells(Rows.Count, 2).End(xlUp).Row + 1'erste leere zeile in Spalte B
  With ActiveSheet
    .Name = .Range("B1")
    .Shapes(1).Delete
    Worksheets("Übersicht").Cells(zeile, 1).FormulaR1C1 = "=" & .Name & "!R4C2" 'Formel einfügen!
    .Range("B1").Copy Destination:=Worksheets("Übersicht").Cells(zeile, 2)
    .Range("B2").Copy Destination:=Worksheets("Übersicht").Cells(zeile, 3)
  End With
End Sub

Gruß der AlteDresdner