Hallo

OK. habs mal nachbebaut...

Sub Nikolas()
    Dim Z1 As Integer, LR As Integer, LC As Integer, SpD As Integer, SpK As Integer
    Dim D As Variant, Zeile As Integer, Datum As Date, TTag As Integer
    Dim AP As String, WT As Integer, BelTage As String, i As Integer
    
    SpD = 2 'Datum in Spalte B
    Z1 = 1 'DatumZeile
        
    With Sheets("Tabelle1")
        LR = .Cells(.Rows.Count, SpD).End(xlUp).Row 'letzte Zeile der Spalte
        LC = .Cells(Z1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
    
        If LR <= Z1 Then
            MsgBox "Keine Eintäge vorhanden"
            Exit Sub
        End If
        
        For Each D In Columns(SpD).SpecialCells(xlCellTypeConstants, 1)
            Zeile = D.Row
            Datum = D.Value
            
            'Einfugetext
            AP = "AP" & .Cells(Zeile, 1)
            
            
            If WorksheetFunction.CountIf(.Rows(Z1), Datum) = 0 Then
                MsgBox "Datum: " & Datum & " nicht gefunden"
            Else
                'Belegte Tage in String (Beispiel:  1, 3, 5, )
                For i = 1 To 7
                    If .Cells(Zeile, SpD + i) = "x" Then
                        BelTage = BelTage & i & ", "
                    End If
                Next

                'Spalte mit Suchdatum
                SpK = WorksheetFunction.Match(CDbl(Datum), .Rows(Z1), 0)
                
                'Wochtag abfragen
                For TTag = SpK To LC
                    WT = Weekday(.Cells(Z1, TTag), vbMonday)
                    
                    'Ist Wochentag ein belegter Tag?
                    If InStr(BelTage, WT) > 0 Then
                        .Cells(Zeile, TTag) = AP
                    Else
                        .Cells(Zeile, TTag).ClearContents
                    End If
                Next

            End If
        Next
    End With
End Sub

LG UweD