Automatische Zuordnung über mehrere WKS

Public Sub Worksheet_Change(ByVal Target As Range)
Dim anzahl As Long
Dim wks As Worksheet
If Target.Address = "$C$1" Then
Range("C3:AAA3").Clear
Application.DisplayAlerts = False
For Each wks In ThisWorkbook.Sheets
If UCase(wks.Name)  "TLN" And _
LCase(wks.Name)  "session 1" Then wks.Delete
Next
Application.DisplayAlerts = True
For anzahl = 1 To Range("C1").Value - 1
Cells(3, anzahl + 2) = "session " & anzahl + 1
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "session " & anzahl + 1
Worksheets("TLN").Activate
Next
End If
End Sub

Private Sub btnZUORDNEN_Click()
Dim wks As Worksheet
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim s() As Variant      'Spalten-Buchstaben Ziel
Dim z As Long           'Zeile Quelle
Dim i As Integer        'Spalte Quelle
i = 2
For Each wks In ActiveWorkbook.Sheets
If UCase(wks.Name)  "TLN" Then
'Überschrift einfügen und Spalten erstellen
Worksheets(wks.Name).Range("A1") = wks.Name
Worksheets(wks.Name).Range("A1").Font.Bold = True
Worksheets(wks.Name).Range("A1").Font.Size = 14
Worksheets(wks.Name).Columns("A:A").AutoFit
Worksheets("session 1").Range("A3:P3").Copy _
Destination:=Worksheets(wks.Name).Range("A3")
'Teilnehmer hinzufügen
Set wksZiel = wks.Name
Set wksQuelle = Worksheets("TLN")
s = Array("A", "B", "C", "D", "E", "F", "G", "H")
With wksQuelle
For z = 4 To .Cells(Rows.Count, i).End(xlUp).Row
Next z
End With
i = i + 1
End If
Next wks
End Sub