Moin!
Ich habe folgendes Problem: Ich soll aus mehreren Worksheets einzelne Zeilen übertragen. Bedingung ist dabei, dass in einer Zeile ein bestimmer Wert vorhanden ist. Bis jetzt habe ich mir folgendes überlegt. Hier komme ich aber nicht weiter. Ich beziehe mich in meinem Beispiel auch nur auf ein weiteres Worksheet. Letztendlich soll ich mich hierbei auf alle Worksheets meiner Datei beziehen und auf der Tabelle 2 die Filterung wiedergeben.
Sub test()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 2
For i = 1 To 10000
With Worksheets("Tabelle1")
If .Cells(i, "G") = "1" Then
Worksheets("Tabelle2").Cells(a, 1).Value = Worksheets("Tabelle1").Cells(i, 1).Value
Worksheets("Tabelle2").Cells(a, 2).Value = Worksheets("Tabelle1").Cells(i, 2).Value
Worksheets("Tabelle2").Cells(a, 3).Value = Worksheets("Tabelle1").Cells(i, 5).Value
a = a + 1
Else
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
gruß Nevron
|