Vorweg: Welches Betriebssystem, Browser und Browserversion hast beim Erstellen des Beitrags verwendet?

Ich frage nur, weil dein Beitrag ist stilistisch 'ne Katastrophe und ich gehe nicht davon aus, dass man sowas einfach nur so runter tippt.

(Beiträge in dieser Art werden hier sehr oft nicht beantwortet. Sie werden einfach ignoriert.)

Ich verwende in diesem Beispiel die Hilfsspalte.

Das Makro ist jedoch flexibel genug - d.h. nicht viele Änderungen notwendig - dies auch ohne jene Hilfsspalte hin zu bekommen.

Vorteil von dieser Lösung ist, dass die Spalten beliebig in ihrer Reihenfolge angeordnet sein können.

Anzupassende Stellen sind im Quellcode gekennzeichnet.

Option Explicit

'///////////////////////////////////////////
'//
Public Sub Example()
  
  On Error GoTo ErrHandler
  
  Dim colaFields(1 To 2) As VBA.Collection
  Dim rngaRow(1 To 2)    As Excel.Range
  Dim rngaField(1 To 2)  As Excel.Range
  Dim strStage As String
  Dim nRecords As Long
  
  Set colaFields(1) = New VBA.Collection
  Set colaFields(2) = New VBA.Collection
  
  'ZIEL
  With Worksheets("Tabelle2") '<- ggf. anpassen
    
    strStage = "Initialisiere (ZIEL)"
    
    'Kopfzeile (Annahme: liegt in Zeile 1 und ist einzeilig)
    Set rngaRow(2) = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
    'Zellen anhand hierer Spaltenbeschriftungen merken
    For Each rngaField(2) In rngaRow(2).Cells
      Call colaFields(2).Add(Key:=Trim$(rngaField(2).Value), Item:=rngaField(2))
    Next
    'erste freie Zeile
    Set rngaRow(2) = rngaRow(2).Offset(1 + .Cells(.Rows.Count, colaFields(2).Item("Farbe").Column).End(xlUp).Row - rngaRow(2).Row)
    
  End With
  
  'QUELLE
  With Worksheets("Tabelle1") '<- ggf. anpassen
    
    strStage = "Initialisiere (QUELLE)"
    
    'Kopfzeile (Annahme: liegt in Zeile 1 und ist einzeilig)
    Set rngaRow(1) = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
    'Zellen anhand hierer Spaltenbeschriftungen merken
    For Each rngaField(1) In rngaRow(1).Cells
      Call colaFields(1).Add(Key:=Trim$(rngaField(1).Value), Item:=rngaField(1))
    Next
    
    strStage = "verarbeite Daten ..."
    
    'aktuell zu verarbeitende Zeile
    Set rngaRow(1) = rngaRow(1).Offset(1)
    'Hilfsspalte referenzieren, aktuelle Zeile
    Set rngaField(1) = CellByField(rngaRow(1), colaFields(1), "Hilfsspalte")
    
    Dim strCriteria As String
    Dim i As Long
    
    strCriteria = "rotMo1" '<- anpassen
    
    Do Until Trim$(rngaField(1).Value) = ""
      
      If 0 = StrComp(rngaField(1).Value, strCriteria, vbTextCompare) Then
        For i = 1 To colaFields(2).Count
          'wenn Spaltenbeschriftung von Ziel in Quelle vorhanden
          If Exists(colaFields(1), colaFields(2).Item(i).Value) Then
            '-> Feldinhalt übertragen (1) -> (2)
            Set rngaField(1) = CellByField(rngaRow(1), colaFields(1), colaFields(2).Item(i).Value)
            Set rngaField(2) = CellByField(rngaRow(2), colaFields(2), colaFields(2).Item(i).Value)
            rngaField(2).NumberFormat = rngaField(1).NumberFormat
            rngaField(2).Value = rngaField(1).Value
          End If
        Next
        nRecords = nRecords + 1
        'nächste Zeile in Ziel
        Set rngaRow(2) = rngaRow(2).Offset(1)
      End If
      
      'nächste zu verarbeitende Zeile
      Set rngaRow(1) = rngaRow(1).Offset(1)
      Set rngaField(1) = CellByField(rngaRow(1), colaFields(1), "Hilfsspalte")
    Loop
    
    strStage = "verarbeite Daten ... beendet"
    
  End With
  
  Call MsgBox("Es wurde(n) " & nRecords & " Zeile(n) übertragen.", vbInformation)
  
Exit Sub
ErrHandler:
  Call MsgBox("Schritt:" & vbNewLine & "  '" & strStage & "'" & vbNewLine & vbNewLine & _
              "Fehler (" & Err.Number & "): " & vbNewLine & _
              Err.Description, _
              vbCritical)
End Sub

'///////////////////////////////////////////
'// Hilfsfunktion von Funktion 'Example'
Private Function CellByField(Row As Excel.Range, Fields As VBA.Collection, Field As String) As Excel.Range
  If Exists(Fields, Field) Then Set CellByField = Row.Cells(1 + Fields(Field).Column - Fields(1).Column)
End Function

'///////////////////////////////////////////
'// Hilfsfunktion von Funktion 'Example'
Private Function Exists(Collection As VBA.Collection, Key As String) As Boolean
  On Error Resume Next
  Call Collection(Key)
  Exists = Not CBool(Err.Number)
End Function

Gruß