nicht ransi, aber...
27.05.2006 19:05:43
K.Rola
Hallo,
vielleicht hilft es trotzdem.
Option Explicit
Sub versiv()
Dim z As Long, lz As Long, rc As Long, ws As Worksheet, z2 As Long
Set ws = Sheets("Tabelle1")
rc = ws.Rows.Count
lz = IIf(ws.Cells(rc, 1) <> "", rc, ws.Cells(rc, 1).End(-4162).Row)
For z = 4 To lz
If ws.Cells(z, 1) >= ws.[a3] And _
ws.Cells(z, 1) < ws.[a3] + 1 Then
'Wenn sie lückenlos untereinander sein sollen:
' z2 = z2 + 1
' ws.Cells(z, 1).Copy Sheets("Tabelle2").Cells(z2, 1)
'Wenn sie an die selbe Stelle kopiert werden sollen
ws.Cells(z, 1).Copy Sheets("Tabelle2").Cells(z, 1)
End If
Next
End
End Sub
Gruß K.Rola