AW: Fehlt vielleich ein "End With" ? o.T
15.11.2004 19:14:17
Winfried
Nein, nein, das hat nichts mit End If oder End With zu tun, es war was ganz läppisches und die Fehlermeldung lockt einen auf den falschen Pfad.
Ich häng mal das Makro an, ich wollte es gerade testen, da sind sicher noch Fehler drin, kann ich aber nicht wegen der Fehlermeldung.
Winfried
Sub Übertrag()
' Dieses Makro kopiert die Daten aus dem "Auditplan" in die Datei "Korrekturmaßnahmen"
Application.ScreenUpdating = False 'keine Bildschirmaktualisierung
Workbooks.Open Filename:=conPfad & "\Korrekturmaßnahmen.xls"
Sheets("Maßnahmen").Unprotect , Password = "*****"
z = 1
Do While z < 2000 'Abfrage läuft bis Zeile 2000
Uebertrag = Cells(z, 1) 'suchen in Spalte 1 (Spalte A)
Select Case Uebertrag
Case Is = "x" 'Wenn Eintag "x"
If Cells(Target.Row, 4) <> "System" Then Exit
Sub 'Andere Möglichkeit: Cells(z, 3) = Cells(z, 9)usw.
'MsgBox "Falsche Eingabe, dies ist kein Systemaudit"
If Cells(Target.Row, 10) = "" Then Exit Sub
'MsgBox "Falsche Eingabe, Auditdatum fehlt"
If Cells(Target.Row, 20) = "" Then Exit Sub
'MsgBox "Falsche Eingabe, Anzahl Hauptabweichungen fehlt"
If Cells(Target.Row, 21) = "" Then Exit Sub
'MsgBox "Falsche Eingabe, Anzahl Nebenabweichungen fehlt"
If Cells(Target.Row, 22) = 0 Then Exit Sub
'MsgBox "Falsche Eingabe, Übertrag unnötig,keine Abweichungen vorhanden"
Case Else
Range("Target.Row, 3, 4, 5, 6, 7, 8, 9, 10").Copy
Workbooks("Korrekturmaßnahmen_Systemaudits.xls").Activate
With Sheets("Maßnahmen")
lgCount = .Range("A65536").End(xlUp).Row 'letzte freie Zeile finden
For iCount = 1 To Cells(Target.Row, 22) 'ermitteln, wie oft geschrieben werden muss
.Range("A" & lgCount + iCount).PasteSpecial Paste:=xlValues 'Werte in Zielbereich einfügen
.Cells(lgCount + iCount, 8) = iCount 'und die Nummer schreiben
Next
End With
Application.CutCopyMode = False
End If
End If
End If
End If
End If
End Select
z = z + 1 'Zeilensprung = 1
Loop 'nächste Zeile
End Sub