Hallo Justus,

Hier der Code:

Public Sub Summieren()
    Dim dest As Worksheet
    Dim cl1 As Range
    Dim cl2 As Range
    Dim cl3 As Range
    Dim x_Werte As Range
    Dim y_Werte As Range
    Dim z_Werte As Range
    Dim sourceRgn As Range
    Dim searchRgn As Range
    Dim destRgn As Range
    Dim Summe As Double
    Set dest = Worksheets("Tabelle3")
    dest.Cells.Clear
    Set destrg = dest.Cells(1, 1)
    Set sourceRgn = Range("A1")
    Set searchRgn = Range("A1:A" & UsedRange.Row + UsedRange.Rows.Count)
    Set sourceRgn = searchRgn.Find("X", sourceRgn).Offset(-1, 0)
    Do While Not sourceRgn Is Nothing And Lrow < sourceRgn.Row
        With sourceRgn
            Set x_Werte = Range(.Offset(1, 1), Cells(.Row + 1, .Offset(1, 1).End(xlToRight).Column))
            Set y_Werte = Range(.Offset(2, 1), Cells(.Row + 2, .Offset(2, 1).End(xlToRight).Column))
            Set z_Werte = Range(.Offset(3, 1), Cells(.Row + 3, .Offset(3, 1).End(xlToRight).Column))
        End With
        For Each cl1 In x_Werte
            For Each cl2 In y_Werte
                For Each cl3 In z_Werte
                    Summe = cl1.Value + cl2.Value + cl3.Value
                    If Summe < 1 Then
                        rgarr = Array(cl1, cl2, cl3)
                        For idx = LBound(rgarr) To UBound(rgarr)
                            destrg.Offset(idx, 0).Value = Cells(sourceRgn.Row, rgarr(idx).Column).Value
                            destrg.Offset(idx, 1).Value = Cells(rgarr(idx).Row, 1).Value
                            destrg.Offset(idx, 2).Value = rgarr(idx).Value
                        Next idx
                        destrg.Offset(3, 0).Value = Summe
                        Set destrg = destrg.Offset(5, 0)
                    End If
                Next
            Next
        Next
        Lrow = sourceRgn.Row
        Set sourceRgn = searchRgn.Find("X", sourceRgn.Offset(1, 0)).Offset(-1, 0)
    Loop
End Sub

Grüße Lutz