Hi ich habe hier wahrscheinlich ein recht simples Problem, aber muss mich leider immer noch zu den Anfängern zählen :-(
Das folgende Skript kopiert über ein button "Auf erledigt setzen" ein komplette Zelle in eine anderes Worksheet. Es funktioniert auch super nur die MsgBox gibt den falschen Wert aus. Die MsgBox gibt zurück das die Zeile eins unter der wirklichen kopiert wurde.
Also die richtige Zeile wurde kopiert passt aber die MsgBox zeigt an das eine Zeile weiter drunter kopiert worden is :-(
Für nen Denkanstoß oder sonstige Hilfen wäre ich sehr dankbar:
Sub RadsaetzeUmtragen()
Dim intRow As Integer
If IsEmpty(Selection.Cells(1, 5)) Then
MsgBox "Fehler - Keine Zeile ausgewaehlt!"
Exit Sub
End If
intRow = 15
Do
If IsEmpty(Worksheets("erledigte Radsätze 2008").Cells(intRow, 4)) Then
Selection.Cells(1, 3).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 2) ' Stk. ist
Selection.Cells(1, 4).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 3) ' Radsatz
Selection.Cells(1, 5).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 4) ' SachNr
Selection.Cells(1, 8).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 5) ' St.-Soll
Selection.Cells(1, 9).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 6) ' Auftrag
Selection.Cells(1, 10).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 7) ' Starttermin
Selection.Cells(1, 11).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 8) ' Solltermin
Selection.Cells(1, 33).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 10) ' RT AKR
Selection.Cells(1, 34).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 11) ' RT Tellerrad
Selection.Cells(1, 35).Copy Worksheets("erledigte Radsätze 2008").Cells(intRow, 12) ' Bemerkung
Selection.EntireRow.Delete
MsgBox "Kopieren der Daten von " & Selection.Cells(1, 4) & " erfolgreich"
Exit Do
End If
intRow = intRow + 1
Loop
End Sub
|