Die Datei https://www.herber.de/bbs/user/5047.xls wurde aus Datenschutzgründen gelöscht
aus dem Thread:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Tabelle2" Or Target.Address(0, 0) <> "B2" Then Exit Sub
ArtAnz = 13 'Anzahl der Artikel
kw = Range("B2").Value 'eingegebene Kalenderwoche
Worksheets("Tabelle1").Activate
Worksheets("Tabelle1").Range(Cells(6, 2), Cells(53, 2 * ArtAnz + 1)).Copy
Worksheets("Tabelle1").Range(Cells(6, 2), Cells(53, 2 * ArtAnz + 1)).PasteSpecial Paste:=xlPasteValues
If WorksheetFunction.CountBlank(Range(Cells(5 + kw, 2), Cells(5 + kw, 2 * ArtAnz + 1))) = 2 * ArtAnz Then
Worksheets("Tabelle2").Range("E4:F56").Clear
Else
For n = 1 To ArtAnz
Worksheets("Tabelle2").Cells(3 + n, 5) = Worksheets("Tabelle1").Cells(5 + kw, n * 2)
Worksheets("Tabelle2").Cells(3 + n, 6) = Worksheets("Tabelle1").Cells(5 + kw, n * 2 + 1)
Next n
End If
For n = 2 To 2 * ArtAnz Step 2
Worksheets("Tabelle1").Cells(5 + kw, n).FormulaLocal = "=Tabelle2!E" & 3 + n / 2
Worksheets("Tabelle1").Cells(5 + kw, n + 1).FormulaLocal = "=Tabelle2!F" & 3 + n / 2
Next n
Application.CutCopyMode = False
Range("B6").Select
Worksheets("Tabelle2").Activate
Range("E4").Select
End Sub
