da ich keine Ahnung habe was du mit dem Daten später noch machst oder welche Formeln da noch so wirken, erstelle ich den Code so wie ich es als korrekt erachte. Missverständnisse in der Umsetzung inklusive. Je besser die Beschreibug ,desto höher die Wahrscheinlichkeit das es gleich beim ersten Mal passt. Entgegen meiner Gewohnheit habe ich den Code kommentiert. Es ist dir nicht verboten unklare Ausdrücke zu googlen. Von einer kostenlosen Gefälligkeit, solltest du keine Wunder erwarten.
Du hast Recht das die Sortierung "verkehrt" herum ist.
With Tabelle2
lastrow = .UsedRange.Rows.Count 'funktioniert nur wenn usedrange in Zeile 1 beginnt
For i = lastrow To 1 Step -1 'rückwärtsschleife macht man so bei Zeilen löschen, sonst kommt der Schleifenzähler durcheinander
If .Range("a" & i) = "" Then 'auf leere Zellen prüfen, dann löschen
Tabelle1.Range("a" & i).EntireRow.Delete
Else
'sonst "kopieren"
'intersect bildet eine Schnittmenge aus der ganzen Zeile (16000 Zellen)
'und dem benutzten Bereich, ergibt viel kleineren Bereich
Set rng = Intersect(.Range("a" & i).EntireRow, .UsedRange)
'prüfen ob es überhaupt was zu "kopieren" gibt
If Not rng Is Nothing Then
'direkte Zuweisung der Werte auf die nächste freie Zeile, ohne kopieraufwand
Tabelle1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(1, rng.Columns.Count).Value = rng.Value
End If
End If
Next i
End With
hier ein anderer Vorschlag. Nur übertragen der nicht leeren Zeilen mit Vorwärtsschleife. Die erste Zeile in Tab1 wird hier festgelegt und bei einem Treffer um 1 erhöht.
Sub Tabellekopieren_und_leereZeilenlöschen_mit_FornextSchleife()
Dim i&, firstrowTab1&, cols&
Dim rng As Range
With Tabelle2
Set rng = Intersect(.Range("A:H"), .UsedRange)
If rng Is Nothing Then Exit Sub
cols = rng.Columns.Count
firstrowTab1 = 0
For i = 1 To rng.Rows.Count
If rng.Cells(i, 1).Value <> "" Then
firstrowTab1 = firstrowTab1 + 1
Tabelle1.Cells(firstrowTab1, 1).Resize(1, cols).Value = rng.Rows(i).Cells.Value
End If
Next i
End With
End Sub
|