Probiers noch mal
24.07.2003 11:30:10
Franz W.
Hallo Hajo,
Vielen Dank für Deine Antwort. Aber komisch ist es schon. Schreibe ich nur (so wie gestern von Dir bekommen :-))):
If rw <= 2 Then
dann macht er's in allen ZEilen außer den Zeilen 1 und 2, das klappt. Aber eben auch unterhalb von LoLetzte. Das wollte ich eben jetzt ausschließen. Und mit: If rw <= 2 Or rw > LoLetzte Then Exit Sub, macht er es in keiner Zeile mehr.
Hier mal der ganze Code, vielleicht ist irgendwo noch was drin, was ich nicht beachtet habe:
Sub ins_Archiv()
Dim Wb As Workbook
Dim Found As Range, sSearch As String
Dim LoLetzte& '(As Long)
Dim ReNr$, ReDatum As Date, AuftrNr%, AuftrDatum As Date, _
KdNr%, KdNName$, KdVName$, Betrag@, bezahlt As Date
Dim rw As Long, varRueck$
Dim Ws As Worksheet
Dim jZahl As Integer
jZahl = Year(Date)
rw = ActiveCell.Row
With Workbooks("RECHNUNGEN_EH.xls").Worksheets("bez" & jZahl)
If .Range("A65536") = "" Then LoLetzte = .Range("A65536").End(xlUp).Row Else MsgBox "Keine Zeile mehr frei!", 16
End With
If rw <= 2 Or rw > LoLetzte Then
ActiveSheet.Protect
MsgBox "Es muss ein Kunde ausgewählt sein!", 16
Exit Sub
End If
If Cells(rw, 10) = "" Then
MsgBox "Es ist noch kein Bezahldatum eingetragen!", 16
Exit Sub
End If
ReNr = Cells(rw, 1)
ReDatum = Cells(rw, 2)
KdNr = Cells(rw, 3)
AuftrNr = Cells(rw, 4)
AuftrDatum = Cells(rw, 5)
KdNName = Cells(rw, 6)
KdVName = Cells(rw, 7)
Betrag = Cells(rw, 8)
bezahlt = Cells(rw, 10)
varRueck = MsgBox("Soll ' " & KdNName & ", " & KdVName & " " _
& " ' im Archiv zur letzten Ruhe gebettet werden?", 36, "Kunden archivieren")
If varRueck = vbNo Then
MsgBox "Ja nacha hoid ned...!", 48, "Kunden löschen"
Exit Sub
End If
MsgBox "Er ruhe sanft.", 48, "Kunden löschen" ' muss raus !!!!!!!!
With Workbooks("RECHNUNGEN_EH.xls").Worksheets("Offene")
.Unprotect
.Range(Cells(rw, 1), Cells(rw, 10)).Delete shift:=xlUp
.Protect
End With
Application.ScreenUpdating = False
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name = "bez" & jZahl Then
GoTo NoNewSht
End If
Next
Sheets("bez" & jZahl - 1).Select
Sheets.Add
ActiveSheet.Name = "bez" & jZahl
NoNewSht:
With Workbooks("RECHNUNGEN_EH.xls").Worksheets("bez" & jZahl)
' .Activate 'Eigentlich nicht nötig
.Unprotect
LoLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
.Cells(LoLetzte, 1) = ReNr
.Cells(LoLetzte, 2) = ReDatum
.Cells(LoLetzte, 3) = KdNr
.Cells(LoLetzte, 4) = AuftrNr
.Cells(LoLetzte, 5) = AuftrDatum
.Cells(LoLetzte, 6) = KdNName
.Cells(LoLetzte, 7) = KdVName
.Cells(LoLetzte, 8) = Betrag
.Cells(LoLetzte, 9) = bezahlt
.Protect
End With
Range("A2").Select
Worksheets("Offene").Activate
End Sub
Vielen Dank schon mal fürs Durchschauen und Grüße
Franz