Fragen und Lösung, wie ichs bisher verstehe
06.04.2018 16:45:49
Zwenn
Hallo Florian,
Gehe ich Recht in der Annahme, dass Sheets("AuftragsNr_filtern") die gleiche Tabelle ist, in die Du weiter unten unter der Bezeichnung Tabelle2 reinkopierst?
Dein Makro sucht in der Tabelle, aus der es gestartet wird. Damit hältst Du es flexiebel. Soll das so sein oder gibt es eine feste Tabelle, in der gesucht werden soll? Dann könntest Du das Makro z.B. vom Tabellenblatt AuftragsNr_filtern mit einem Button starten
Kann der gesuchte Wert nur ein einziges Mal vorkommen oder kann er auch öfter vorliegen?
Falls er nur einmal vorkommen kann, füge vor End If noch Exit For ein. Damit wird die Schleife sofort verlassen, wenn der Wert gefunden und die entsprechende Zeile kopiert wurde.
Das ist dann noch immer keine optimale Lösung. Es läuft aber schon wesentlich schneller durch, sofern es nur ein Wert ist, der pro Makrostart gefunden werden soll. Allerdings nur, solange er sich möglichst weit vorne befindet.
Für den Fall sieht Dein Makro mit etwas sortiertem Code dann so aus:
(Das Else kannst Du weglassen, wenn Du keinen alternativen Code ausführen willst. Variablendeklarationen solltest Du der Übersichtlichkeit immer alle zusammen ganz nach oben schreiben, darunter dann die ersten notwendigen Initialisierungen und dann der restliche Code.)
Dim x As Long
Dim y As Long
Dim lastRow As Long
Dim a As Long
y = 26
a = Sheets("AuftragsNr_filtern").Range("C3").Value
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("AuftragsNr_filtern").Range("A26:H1000").ClearContents
For x = 1 To lastRow
If Cells(x, 1) = a Then
Rows(x).Copy Destination:=Tabelle2.Rows(y)
y = y + 1
Exit For
End If
Next x
End Sub
Die bessere Lösung ist der Ansatz mit dem Autofilter, wie von Werner vorgeschlagen. Damit werden alle gefilterten Zeilen kopiert. Egal ob eine oder mehrere:
Public Sub kopieren()
Dim y As Long
Dim a As Long
y = 26
a = Sheets("AuftragsNr_filtern").Range("C3").Value
Worksheets("AuftragsNr_filtern").Range("A26:H1000").ClearContents
If WorksheetFunction.CountA(Columns(1), a) > 0 Then
ActiveSheet.Columns(1).AutoFilter 1, a
ActiveSheet.AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("AuftragsNr_filtern"). _
Cells(y, 1)
ActiveSheet.Columns(1).AutoFilter
End If
End Sub
Viele Grüße,
Zwenn