Daten in verschiedene Tabellenblätter ko

Hallo Forum

Ich habe folgenden VBA-Code zusammengebastelt, der grundsätzlich funktioniert, solange ich alle Daten in das gleiche Tabllenblatt(1) der Zieldatei kopiere. Ich möchte die Daten aber wenn möglich in verschiedene Tabellenblätter der Zieldatei einfügen (z.B. Urlaubstage in Tabelle ("Urlaub"), Krankheitstage in Tabelle ("Krankheit"), Weiterbildungstage in Tabelle ("Weiterbildung"), etc.). Leider weiss ich nicht wie ich den Code anpassen muss um das zu erreichen. Wer kann mir helfen?

Sub Test_1()

Dim sPfad As String
Dim wbQuelle As Workbook
Dim wsZiel As Worksheet
Dim sDatei As String
Dim iZeile As Integer
Dim sMitarbeiter As String
Dim rngZiel As Range
Dim rngSuche As Range
iZeile = 20

'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Setzen des Ziel-Arbeitsblatts
Set wsZiel = ThisWorkbook.Worksheets(1)

'Ordnerpfad
sPfad = "C:\Users\danie\Desktop\Praxis\Stundenerfassung\Datenbank\"

'Durchlaufen der Quelldateien im Ordner
sDatei = Dir(sPfad & "*.xlsx")
Do While sDatei > ""

'Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(sPfad & sDatei)

'Durchlaufen der Mitarbeiter in der Zieldatei
For Each rngZiel In wsZiel.Range("B20:B30")

'Mitarbeitername aus der Zieldatei
sMitarbeiter = rngZiel.Value

'Suchen des Mitarbeiters in der Quelldatei
Set rngSuche = wbQuelle.Worksheets(1).Range("B3:B100").Find(sMitarbeiter, LookIn:=xlValues, lookat:=xlWhole)

'Wenn Mitarbeiter gefunden wurde, kopieren und einfügen
If Not rngSuche Is Nothing Then

'iZeile = rngZiel.Row 'Zeilennummer in der Zieldatei
wsZiel.Range("Q" & iZeile).Value = wbQuelle.Worksheets(1).Range("B18").Value
wsZiel.Range("R" & iZeile).Value = wbQuelle.Worksheets(1).Range("AJ9").Value
wsZiel.Range("S" & iZeile).Value = wbQuelle.Worksheets(1).Range("AJ10").Value
wsZiel.Range("T" & iZeile).Value = wbQuelle.Worksheets(1).Range("AJ11").Value
wsZiel.Range("U" & iZeile).Value = wbQuelle.Worksheets(1).Range("AI21").Value

End If

iZeile = iZeile + 1

Next rngZiel
iZeile = 20 'setze iZeile zurück auf 20

'Arbeitsmappe schließen
wbQuelle.Close SaveChanges:=False

'Nächste Datei im Ordner durchlaufen
sDatei = Dir()

Loop

'ScreenUpdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Schon mal zum voraus vielen Dank für Eure Ideen.

Liebe Grüsse
Dan