AW: Zeilen sortiert in andere Tabelle verschieben
31.08.2007 15:58:00
Chaos
Servus,
hab dir mal das geschrieben:
Sub Kopie()
Dim zeile As Long, loLetzte As Long
loLetzte = IIf(IsEmpty(Sheets(1).Cells(Rows.Count, 2)), Sheets(1).Cells(Rows.Count, 2).End(xlUp) _
.Row, Rows.Count)
loletzte1 = IIf(IsEmpty(Sheets(2).Cells(Rows.Count, 2)), Sheets(2).Cells(Rows.Count, 2).End( _
xlUp).Row, Rows.Count)
loletzte2 = loletzte1 + 1
For zeile = loLetzte To 2 Step -1 ' kopieren und löschen
If Sheets(1).Cells(zeile, 2).Value = "abgeschlossen" Then
Sheets(1).Cells(zeile, 2).EntireRow.Copy Sheets(2).Range("A" & loletzte2)
Sheets(1).Cells(zeile, 2).EntireRow.Delete
loletzte2 = loletzte2 + 1
End If
Next zeile
Dim LoLetzteNeu As Long
LoLetzteNeu = IIf(IsEmpty(Sheets(2).Cells(Rows.Count, 2)), Sheets(2).Cells(Rows.Count, 2).End( _
xlUp).Row, Rows.Count)
With Sheets(2) ' sortieren
On Error Resume Next
.Range("A2:A" & LoLetzteNeu).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub
Es wird erst kopiert und dann ans chließend sortiert. Wenn du doppelte vermeiden möchtest, dann kann man das so lösen
With Sheets(2) ' doppelte löschen
Dim zeile2 As Long
For zeile2 = loLetzteNeu To 2 Step -1
If .Cells(zeile2, 1).Value = .Cells(zeile2 -1, 1).Value Then
.Cells(zeile2, 1).EntireRow.Delete
End if
Next zeile2
End with
Das kann man nach dem sortieren ausführen. Es werden aber nur die Werte der Spalte A verglichen.
Gruß
Chaos