Hi mela,

für den Zeitraum 01.01.2017 - 31.12.2021 ist  "Zeile7, Spalte J-JI " ff. wohl zu knapp bemessen oder du bestimmst die KW nicht nach Norm (01.01.2017 = KW52).

wfinden = Range("J9:JI9").Find(What:=woche)

Beginnt immer bei "J10" und liefert den ersten Treffer (unabhängig von der Jahreszahl)!

Ergo den .Find(Jahreszahl)  immer vom Ende des Bereichs weg, dann kehrt die Suche um und beginnt mit der ersten Zelle.

Hattu Treffer, dann kannst du den Suchbereich für die KW-Zeile ab Treffer.Offset(2) bis Ende Zeile 9 ermitteln und

dort wieder nach dem Muster der Jahreszahl von hinten durch die Brust ins Auge weitersuchen.

Die Range.Find somit vom Parameter "What" bis zum Parameter "SearchDirection" richtig versorgen!

Einfacher geht es auch bei richtig aufgestellter Registerleiste Zeile 7 bis 9 über Array und die Spalten "F:G" sind ohnedies Nato ;-)

Zum Bleistift:

Option Explicit

Sub Testzeile()
Dim x As Long

   For x = 23 To 33
      Call InZeile(x)
   Next x
End Sub


Function InZeile(Zeile As Long)
'Datumsangaben in Spalte "E"
'Umrandet wird die Zelle der Zeile x rechts von "Ex"
'Register beginnend mit "J7" bzw. "J9"

'
Dim Arr() As Variant
Dim dtm As Date
Dim kw As Long, y As Long

   'Register Kopfzeilen Bereich
   Arr = Range(Range("J7"), Range("J7").End(xlToRight)).Resize(3)
   
   On Error Resume Next
   dtm = Columns("E").Cells(Zeile)
   'Norm KW beachten
   If dtm < DateSerial(2017, 1, 1) Or dtm > DateSerial(2021, 12, 31) Then Exit Function
   If Err.Number <> 0 Then Exit Function
   On Error GoTo 0
   
   For y = LBound(Arr, 2) To UBound(Arr, 2)
      If Arr(1, y) = Year(dtm) Then Exit For
   Next y
   'Debug.Print y, Arr(1, y)
   For kw = y To UBound(Arr, 2)
      If Arr(3, kw) = WorksheetFunction.IsoWeekNum(dtm) Then Exit For
   Next kw
   'Debug.Print kw, Arr(3, kw)
   
   With Cells(Zeile, 9).Offset(, kw).Borders
      .LineStyle = xlContinuous
      .Weight = xlThick
   End With
   
End Function