Ich habe Office Professional Plus 2016

Hallo Gast42222,

vielen Dank für deine schnelle Hilfe, aber leider hat es nicht funktioniert.

Beim ausführen des Scripts hat es keine Auswertung erstellt und es gab auch keine Fehlermeldung. 

Zum besseren Verständnis habe ich hier mal ein Bild angehängt und den Code, der die Daten, so wie im unteren Teil des Bildes,
auswirft. In den Zelle A wird immer der gleiche Text aus Zeile 14 ermittelt. Schön wäre es, wenn die Daten immer in eriner Zeile wären,
aber ich wäre schon zufrieden, wenn es wenigstens den korrekten Text aus den Zellen A zu den entsprechenden Daten anzeigen würde.

Gruß Reinhold

Sub SucheKalenderwoche()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim kalenderwoche As Long
    Dim outputRow As Long

    Set ws = ThisWorkbook.Sheets("Timingeins") ' Ersetze "DeinBlattName" durch den Namen deines Blatts
    Set rng = ws.Range("14:21") ' Die zu überprüfende Zeile 14
    outputRow = 50 ' Zeile, in der die Kalenderwochen ausgegeben werden sollen

    ' Loop durch jede Zelle in der Zeile
    For Each cell In rng
        ' Überprüfe die Farbe der Zelle (Blau - Farbcode 33)
        If cell.Interior.Color = RGB(0, 176, 240) Then
            ' Wenn die Zelle blau ist, ermittel die Kalenderwoche aus Zeile 3
            kalenderwoche = ws.Cells(3, cell.Column).Value

            ' Gib den Text aus Zelle A14 in Zeile 50, Spalte A, aus
            ws.Cells(outputRow, "A").Value = ws.Cells(14, "A").Value

            ' Gib die ermittelte Kalenderwoche in der gewünschten Zeile aus (ab Zeile 50)
            ws.Cells(outputRow, cell.Column).Value = kalenderwoche

            ' Inkrementiere die Ausgabezeile für die nächste gefundene Kalenderwoche
            outputRow = outputRow + 1
        End If
    Next cell
End Sub