Excel-Makro gesucht: Zusammenführen der verteilten Inhalte mehrerer markierter Zeilen in eine

Option Explicit

Const iColMax = 40

Public Sub Zusammenfassen()
    Dim aValues As Variant, aNewValues(1 To 1, 1 To iColMax) As Variant
    Dim iRowValue As Long, iRowFirst As Long, iRowNext As Long, iRowLast As Long, r As Long, c As Long
    
    If Selection.Rows.Count < 2 Then
        MsgBox "Es müssen mindestens 2 Zeilen markiert sein!", vbInformation, "Hinweis...":  Exit Sub  
    End If
    
    aValues = Selection.Value
    
    iRowValue = GetRowValue(aValues)
    iRowFirst = Selection.Row
    iRowNext = iRowFirst + 1
    iRowLast = iRowFirst + Selection.Rows.Count - 1
    
    aNewValues(1, 1) = aValues(iRowValue, 1)
    aNewValues(1, 2) = aValues(iRowValue, 2)
    
    For r = 1 To UBound(aValues, 1)
        For c = 3 To iColMax
            If Not IsEmpty(aValues(r, c)) Then
                aNewValues(1, c) = aValues(r, c)
            End If
        Next
    Next
    
    Rows(iRowNext & ":" & iRowLast).Delete Shift:=xlUp  
    Cells(iRowFirst, 1).Resize(1, iColMax).Value = aNewValues
End Sub

'Array-Zeile mit Wert in Spalte A ermitteln  
Private Function GetRowValue(ByRef aValues) As Long
    Dim i As Long
    
   'Falls Spalte A leer, dann Wert für Spalte B aus 1.er Array-Zeile  
    GetRowValue = 1

    For i = 1 To UBound(aValues, 1)
        If Not IsEmpty(aValues(i, 1)) Then
            GetRowValue = i:  Exit For
        End If
    Next
End Function