Hi.

Angesichts der Bilder könnte man es so lösen:

Wichtig dabei: Die Daten müssen - wie von dir im Bild gezeigt - nach den ersten beiden Spalten (season, name_uch) gruppiert / sortiert vorliegen.

Du musst ggf. den Tabellennamen im Code ändern.

Option Explicit

Public Sub Test()
  
  Dim rng As Excel.Range
  Dim rngCur As Excel.Range
  Dim rngSrc As Excel.Range
  Dim rngDst As Excel.Range
  Dim lngDstMax As Long
  
  'header row
  Set rng = Worksheets("Tabelle1").Range("A1:D1")
  'first data row
  Set rngCur = rng.Offset(1)
  
  'most right column
  lngDstMax = rngCur.End(xlToRight).Column
  
  Do Until WorksheetFunction.CountBlank(rngCur.Offset(1)) > 0
    
    Set rngSrc = rngCur.Offset(1)
    
    'compare first columns: 'season'
    If rngCur.Cells(1).Value = rngSrc.Cells(1).Value Then
      'compare second columns: 'name_uch'
      If rngCur.Cells(2).Value = rngSrc.Cells(2).Value Then
        'get destination
        Set rngDst = rngCur.End(xlToRight).Offset(, 1)
        If rngDst.Column > lngDstMax Then lngDstMax = rngDst.Column 'remember most right column
        'move shepherd & livestock
        Call rngSrc.Offset(, 2).Resize(, rngSrc.Columns.Count - 2).Cut(rngDst)
        Call rngSrc.EntireRow.Delete
      Else
        Set rngCur = rngCur.Offset(1)
      End If
    Else
      Set rngCur = rngCur.Offset(1)
    End If
    
  Loop
  
  'copy shepherd & livestock header (multiple times)
  Set rngCur = rng.End(xlToRight).Offset(, -1).Resize(, 2)
  Set rngDst = rngCur.Offset(, 2).Resize(, lngDstMax - rngCur.Column)
  Call rngCur.Copy(rngDst)
  
End Sub

1. Das Makro vergleicht einfach zwei untereinander liegende Zeilen anhand ihrer Werte in den Spalten season und name_uch.
2. Solange diese gleich sind, fügt er den Datenteil aus Sheperd und Livestock aus der unteren Zeile ans rechte ende der oberen Zeile.
3. Sobald sie sich unterscheiden, wird dieser Vergleich um eine Zeile tiefer geschoben und das ganze startet wieder bei Punkt 1.

Grüße

Trägheit