Dim YesNo as Long
Dim lngSheet as Long
YesNo = 6
Do
For lngCol = 1 To 17 Step 4
lngSheet = Application.Inputbox("Auf wlches Blatt (numerisch!) sollen die Daten eingetragen werden?", "Blattauswahl...", 3, , , , , 1)
x3WB.Sheets(lngSheet).Activate
If x3WB.Sheets(lngSheet).Cells(2, lngCol) = "" Then
x3WB.Sheets(lngSheet).Cells(2, lngCol) = Target.Offset(0, -1) & "/" & Target
x3WB.Sheets(lngSheet).Cells(4, lngCol) = Target.Offset(0, 2)
x3WB.Sheets(lngSheet).Cells(5, lngCol) = Target.Offset(0, 9)
x3WB.Sheets(lngSheet).Cells(6, lngCol) = Target.Offset(0, 10)
x3WB.Sheets(lngSheet).Cells(3, lngCol) = Target.Offset(0, 3)
x3WB.Sheets(lngSheet).Cells(7, lngCol) = Target.Offset(0, 11)
End If
Next lngCol
YesNo = MsgBox("Weiteren Durchlauf starten?", vbYesNo + vbQuestion, "Neuer Durchlauf...")
Loop Until YesNo <> 6
Severus
|