Hallo zusammen
 

Ich habe mir im Excel einen VBA Code geschireben der folgendes machen soll. Alle Zellen in einer Range speichern welche die Bedingung im ersten Makros  erfüllen (siehe Code unten). Diese Zellen können einzelne oder zusammenhängende Zellen sein, wild verteilt über das ganze Arbeitsblatt. Ich möchte nun abhängig vom VerschiebenWert diese einzelnen Areas rückwärts oder vorwärts durchlaufen. Vorwärts klappt ohne Problem. Rückwärts (rechts nach links) geht jedoch nicht. Wichtig: Ich möchte die Areas als gesamtes bearbeiten und nicht jede Zelle einzeln. Also sprich Zellen die an keine zutreffende Zellen angrenzen werden einzeln angewählt, zusammenhängende Zellen werden als Range angewählt. Könnt ihr mir helfen warum das nicht klappt?

Als Beispiel wie die Rückwärtsschlaufe sein müsste: Die grünen Zellen sind jene die bei der die Bedingung zutreffen würden. Die Zahlen bedeuten welche Zellen zusammen in welcher Reihenfolge markiert werden sollen. 

Code:
Das cellArea.Select ist eigentlich nur eine Zwischenkontrolle, danach möchte ich mit den einzelnen Areas ein weiteres Makros ausführen. Auch das area.Select ist nur eine Zwischenkontrolle. Bei der Rückwärtsschlaufe ist es so, dass es jeweils in der ersten Zeile klappt, aber ab der zweiten Zeile jedoch nicht mehr. Um entweder die vorwärts oder rückwärtsschlaufe auszulösen könnt ihr einfach bei VerschiebenWert = -3 die Zahl anpassen.
 

Option Explicit
'funktioniert
Sub ZeitlböckeSuchen()
    Dim selectedRange As Range
    Dim currentRow  As Range
    Dim cell        As Range
    Dim cellsToExecute As Range
    VerschiebenWert = -3
    ' Überprüfen, ob ein Bereich ausgewählt ist
    If TypeName(Selection) <> "Range" Then
        MsgBox "Bitte wählen Sie einen Zellbereich aus, bevor Sie den Code ausführen.", vbExclamation
        Exit Sub
    End If
    
    ' Den ausgewählten Bereich speichern
    Set selectedRange = Selection
    
    ' Durch jede Zeile im ausgewählten Bereich iterieren
    For Each currentRow In selectedRange.Rows
        ' Range für die aktuellen Zellen in der Zeile erstellen
        Set cellsToExecute = Nothing
        
        For Each cell In currentRow.Cells
            ' Überprüfen, ob die Zelle die angegebene Farbe oder den angegebenen Wert hat
            If cell.Interior.Color <> RGB(242, 242, 242) Or cell.Value = ChrW(9670) Then
                If cellsToExecute Is Nothing Then
                    Set cellsToExecute = cell
                Else
                    Set cellsToExecute = Union(cellsToExecute, cell)
                End If
            End If
        Next cell
        
        ' Überprüfen, ob es Zellen zum Ausführen gibt
        If Not cellsToExecute Is Nothing Then
            
            ZeitblöckeEinzelnDurchlaufen cellsToExecute
            
        End If
    Next currentRow
End Sub
'code zum anpassen
Sub ZeitblöckeEinzelnDurchlaufen(Zeitblock As Range)
    'Dim selectedRange As Range
    Dim area        As Range
    Dim row         As Range
    Dim lngArea     As Long
    Dim i           As Integer
    Dim selectedArea As Range
    Dim cellArea    As Range
    
    Zeitblock.Select
    MsgBox "select"
    ' Überprüfen, ob eine Zeitblock vorhanden ist
    If Zeitblock.Count > 0 Then
        ' Durchlaufen der ausgewählten Zeilen
        If VerschiebenWert < 0 Then
            For Each row In Zeitblock.Rows
                ' Durchlaufen der Bereiche (zusammenhängende Zellen) in der Zeile
                For Each area In row
                    ' Anzeigen der Adresse des Bereichs in einer MsgBox
                    area.Select
                    MsgBox "select negativ  " & VerschiebenWert
                Next area
            Next row
        Else
            For Each cellArea In Zeitblock.Rows
                ' Durchlaufe jede Area (Zellenbereich) von rechts nach links
                For i = cellArea.Areas.Count To 1 Step -1
                    ' Setze die aktuelle Area
                    Set selectedArea = cellArea.Cells(1, i)
                    cellArea.Select
                    MsgBox "select positiv" & VerschiebenWert
                    
                Next i
                
            Next cellArea
        End If
    Else
        MsgBox "Es wurden keine Zellen ausgewählt.", vbExclamation
    End If
End Sub

Vielen Dank schon jetzt für eure Hilfe:)