Private Sub ArztAnlegen(rngB As Range)
Dim rngK As Range, lngI As Long
For Each rngK In rngB
If rngK.Row > 1 Then
If Len(rngK) "" Then
For lngI = 1 To Sheets.Count
If Sheets(lngI).Name = "" & rngK Then
MsgBox "Das Blatt " & rngK & " gibt es schon!"
Exit For
End If
Next lngI
If lngI > Sheets.Count Then
Sheets("Muster").Copy After:=Sheets(lngI - 1)
With ActiveSheet
.Name = rngK
.Cells(7, 4) = rngK
.Protect Password:=rngK
End With
End If
End If
End If
Next rngK
End Sub
Ich danke schon mal für die Hilfe.
Gruß Oblivion