Bestimmte Zellen füllen und dann um bestimmten Abstand weiter springen VBA

[ExcelFoley69]

Liebes Forum,
ich würde gerne eine Tabelle erstellen und diese soll sich über ein VBA Skript dyamisch füllen.
Ich möchte das die Ursprungstabelle nach einem bestimmten Wert durchsucht wird ( im Anhang die Wert in Spalte B Ursprungstabelle). 
Dieser Wert soll dann in einer definierten Zelle in der Ausgabetabelle ausgegeben werden und eine Zelle darunter die Werte die sich in der Selben Zeile befinden jedoch in den Spalten E und F, wenn das Suchkriterium erneut gefunden wird soll um zwei Spalten nach rechts gesprungen werden und diese erneut eingetragen werden bis alle Einträge die das Suchkriterium erfüllt haben eingetragen sind.
Im Anschluss soll nach einem neuen Kriterium gesucht werden und diese Ergebnisse im selben Format wie oben 3 Zeilen darunter ausgegeben werden und erneut mit zwei Spalten Abstand die anderen Suchergebnisse wie oben eintragen.
Ich habe in der Datei im Anhang dargestellt wie ich es meine, falls es hier nicht verständlich ist.
Was noch wichtig wäre, dass wenn ein Suchkriterium nicht vorkommt, dass dann dort keine zwei Zeilen freigelassen werden, sondern zum nächsten Kriterium gesprungen wird. Das die Abstände unter den gefundenen Werten immer gleich sind, auch wenn eines in einer Tabelle mal nicht vorkommt.
Liebe Grüße
Excel :19:

[schauan]

Hallöchen,

hier ein Code für ein normales Modul. Ausführen tust Du den, wenn das Blatt mit den Quelldaten aktiv ist. Den Projektleider müsstest Du selber eintragen, der muss aber auch immer in Zeile 2 bei der Quelle bleiben

Code:

Sub test()
'Variablendeklarationen
Dim iCnt%, rCnt%, cCnt%
'Startwert setzen fuer Quellzeile, Zielzeile und Zielspalte
iCnt = 3: rCnt = 2: cCnt = 3
'Schleife solange was in Spalte B steht
Do While Cells(iCnt, 2) <> ""
  'Wenn in der Zelle in B was anderes steht als in der vorigen Zelle,
  'Startwerte neu setzen
  If Cells(iCnt, 2) <> Cells(iCnt - 1, 2) Then rCnt = rCnt + 5: cCnt = 3
  'Mit der Zelle Zeile, Spalte dem Blatt Ausgabe
  With Sheets("Ausgabe").Cells(rCnt, cCnt)
     'Vorname und Name uebernehmen
     .Value = Cells(iCnt, 5) & " " & Cells(iCnt, 6)
     'darunter Funktion eintragen
     .Offset(1, 0).Value = Cells(iCnt, 2)
  'Ende Mit der Zelle Zeile, Spalte dem Blatt Ausgabe
  End With
  'Quellzeile und Zielspalte erhöhen
  iCnt = iCnt + 1: cCnt = cCnt + 2
'Ende Schleife solange was in Spalte B steht
Loop
End Sub