Zeilen automatisch kopieren
19.08.2004 22:26:03
Andreas
Sub KopiereInMappe()
Dim ber As String
Dim i, lz As Long
ber = ""
lz = Range("A65535").End(xlUp).Row
For i = 1 To lz
If Cells(i, 3).Value >= 0.1 Then
ber = ber & i & ":" & i & ","
End If
Next i
If ber = "" Then
MsgBox "keine Zeile markiert!"
Exit Sub
End If
ber = Left(ber, Len(ber) - 1)
Range(ber).Copy
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.Range("A:A").Delete
Range("A1").Select
End Sub
Eigentlich hat es, bei geringer, zu kopierender Zeilenanzahl wunderbar funktioniert. Da die Datenbank jetzt grösser ist, wird mehr markiert. Leider verursacht das Skript bei mehr als 25 Einträgen in der Datenbank einen Laufzeitfehler in der Zeile "Range(ber).Copy".
Hier kurz die Funktion des Skriptes:
Bestimmte Zeilen werden markiert mit 1 ; wenn 1 dann komplette Zeile in ein neues Arbeitsblatt oder eine neue Arbeitsmappe kopieren. Ansonsten weiter. Schön ist es, wenn Formatierungen mit übernommen werden. Aber das ist nicht nötig.
Kann mir bitte jemand helfen? Andreas