Option Explicit
Sub Aufheben()
Dim WsTabelle As Worksheet
Dim woche, s, stelle, o As Range
Dim w, a, b As Integer
Dim i As Variant
Dim test As Long
Dim KW, Jahr, wert, AktuellesBlatt, StartBlatt, EndBlatt, AnzahlBlätter, Spalte, firstadress, Reihe, Zeile, sachnummer, IST As String
StartBlatt = Sheets(1).Name
AnzahlBlätter = ThisWorkbook.Sheets.Count
For w = 1 To 3
With Worksheets(w)
KW = Mid(.Name, 1, 4)
Jahr = Right(.Name, 2)
Spalte = "20" & Jahr & KW
For Each s In .Range("G3:G2000")
If s.Value = "" _
Then GoTo s_continue
sachnummer = s.Value
IST = s.Offset(0, 8).Value
With Sheets("Übersicht").Range("A1:XX2000")
Set woche = .Find(Spalte, LookIn:=xlValues)
If IsEmpty(woche) _
Then GoTo s_continue
Set stelle = .Find(sachnummer, LookIn:=xlValues)
If IsEmpty(stelle) _
Then GoTo s_continue
Set o = .Cells(stelle.Row, woche.Column)
o.Value = IST
End With
s_continue:
Next s
End With
Next
End Sub