Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1672to1676
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Autofilter Ergebnis kopieren und Filter Reset

Autofilter Ergebnis kopieren und Filter Reset
14.02.2019 12:52:52
Christoph
Hallo zusammen,
aktuell habe ich in einer Exceldatei im Blatt "Datenbank" in den Spalten a-g Daten eingetragen.
Im Blatt "Abfrage_Händler" in Zelle C3 wird der Name oder ein Teil des Names eingegeben.
Per VBA soll dann auf die Daten in "Datenbank" Spalte E der Autofilter laufen.
In Zeile 1 "Datenbank" steht eine Überschrift, die soll nicht mit kopiert werden.
Soweit bin ich mit VBA schon gekommen.

Sub Filtern()
Range("Datenbank!B1:G1").AutoFilter Field:=4, Criteria1:="*" & Range "Abfrage_Händler!C3"). _
_
Value & "**"
End Sub
Jetzt fehlt mir noch der Part, der die Ergebnise dieses Filters in "Abfrage_Händler" Zellen F4 - _
_
K4 und darunter kopiert.
Und nach dem kopieren sollen alle Filter in "Datenbank" wieder zurückgesetzt werden.
Als kleine Schwierigkeit sind in "Abfrage_Händler" in den Spalten A-D bis Zeile 20 Erlä _
uterungen eingetragen, diese dürfen durch den Kopierprozess natürlich nicht wegfallen.
Kann mir jemand da helfen?
Viele Grüße
Christoph


		

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Autofilter Ergebnis kopieren und Filter Reset
14.02.2019 12:57:53
Werner
Hallo Christiph,
lad mal eine Beispielmappe mit den zwei Blättern und ein paar Datensätzen hoch. Vor allem solltest du dein Wunschergebnis anhand von ein paar Beispielen aufzeigen.
Gruß Werner
AW: Autofilter Ergebnis kopieren und Filter Reset
14.02.2019 15:54:56
Christoph
Hallo Thorsten,
leider funktioniert das ganze leider noch nicht so richtig.
Nach Ausführung Makro "Filtern" und Makro "kopieren" werden beim ersten Durchlauf die ersten 19 Zeilen der Datenbank kopiert, der Filter wird ignoriert.
Beim zweiten Mal wird die nächste Zeile der Datenbank angehängt usw.
Darüber hinaus ist mir bei der Benutzung aufgefallen, dass ich ja die Ergebnisanzeige auch wieder löschen muss wenn ich eine neue Suche anstosse.
Sprich nach dem "kopieren" muss bei erneutem "suchen" das Ergebnis vorher gelöscht sein.
Viele Grüße
Christoph
Anzeige
und hier der Code
14.02.2019 15:56:25
Werner
Hallo Christoph,
wobei noch unklar ist, was passieren soll bei folgenden Suchen. Die Treffer untereinander ins Zielblatt (das macht im Moment mein Code)? Die Zieltabelle zunächst leeren und die Treffer dann kopieren?
Sub Filtern()
Dim loLetzte As Long
If Worksheets("Abfrage_Händler").Range("C3")  "" Then
With Worksheets("Datenbank")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Row
If WorksheetFunction.CountIf(.Range(.Cells(2, 6), .Cells(loLetzte, 6)), _
"*" & Worksheets("Abfrage_Händler").Range("C3") & "*") > 0 Then
If .FilterMode Then .ShowAllData
.Range("B1:G1").AutoFilter Field:=4, Criteria1:="*" & _
Worksheets("Abfrage_Händler").Range("C3") & "*"
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
With Worksheets("Abfrage_Händler")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Offset(1).Row
.Cells(loLetzte, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
If .FilterMode Then .ShowAllData
Else
MsgBox "Kein Treffer"
End If
End With
End If
End Sub
Gruß Werner
Anzeige
mit vorherigem Löschen des Zielbereiches
14.02.2019 16:22:15
Werner
Hallo Christoph,
dann so:
Sub Filtern()
Dim loLetzte As Long
If Worksheets("Abfrage_Händler").Range("C3")  "" Then
With Worksheets("Datenbank")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Row
If WorksheetFunction.CountIf(.Range(.Cells(2, 6), .Cells(loLetzte, 6)), _
"*" & Worksheets("Abfrage_Händler").Range("C3") & "*") > 0 Then
If .FilterMode Then .ShowAllData
.Range("B1:G1").AutoFilter Field:=4, Criteria1:="*" & _
Worksheets("Abfrage_Händler").Range("C3") & "*"
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
With Worksheets("Abfrage_Händler")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Offset(1).Row
.Range(.Cells(4, 6), .Cells(loLetzte, 11)).ClearContents
.Cells(4, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
If .FilterMode Then .ShowAllData
Else
MsgBox "Kein Treffer"
End If
End With
End If
End Sub
Gruß Werner
Anzeige
AW: mit vorherigem Löschen des Zielbereiches
14.02.2019 22:25:51
Christoph
Hallo Werner,
danke für die schnelle Antwort.
Leider kommt beim Ausführen Fehler 1004 und beim Debuggen wird auf diese Zeile verwiesen:
.Cells(4, 6).PasteSpecial Paste:=xlPasteValues
Viele Grüße
Christoph
AW: mit vorherigem Löschen des Zielbereiches
14.02.2019 22:51:48
Werner
Hallo Christoph,
bei mir beim Testen mit deiner Beispielmappe hat es problemlos funktioniert. Vermutlich wird der Kopierspeicher durch das ClearContents geleert, warum auch immer. Das Problem hatte ich neulich schon mal.
Versuchs mal damit:
Sub Filtern()
Dim loLetzte As Long
If Worksheets("Abfrage_Händler").Range("C3")  "" Then
With Worksheets("Datenbank")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Row
If WorksheetFunction.CountIf(.Range(.Cells(2, 6), .Cells(loLetzte, 6)), _
"*" & Worksheets("Abfrage_Händler").Range("C3") & "*") > 0 Then
With Worksheets("Abfrage_Händler")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Row
.Range(.Cells(4, 6), .Cells(loLetzte, 11)).ClearContents
End With
If .FilterMode Then .ShowAllData
.Range("B1:G1").AutoFilter Field:=4, Criteria1:="*" & _
Worksheets("Abfrage_Händler").Range("C3") & "*"
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
Worksheets("Abfrage_Händler").Cells(4, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
If .FilterMode Then .ShowAllData
Else
MsgBox "Kein Treffer"
End If
End With
End If
End Sub
Gruß Werner
Anzeige
Fehler - Änderung
15.02.2019 05:38:14
Werner
Hallo Christoph,
da war mir beim Kopieren noch ein Fehler rein gerutscht. Nimm den Code:
Sub Filtern()
Dim loLetzte As Long
If Worksheets("Abfrage_Händler").Range("C3")  "" Then
With Worksheets("Datenbank")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Row
If WorksheetFunction.CountIf(.Range(.Cells(2, 6), .Cells(loLetzte, 6)), _
"*" & Worksheets("Abfrage_Händler").Range("C3") & "*") > 0 Then
With Worksheets("Abfrage_Händler")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Offset(1).Row
.Range(.Cells(4, 6), .Cells(loLetzte, 11)).ClearContents
End With
If .FilterMode Then .ShowAllData
.Range("B1:G1").AutoFilter Field:=4, Criteria1:="*" & _
Worksheets("Abfrage_Händler").Range("C3") & "*"
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
Worksheets("Abfrage_Händler").Cells(4, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
If .FilterMode Then .ShowAllData
Else
MsgBox "Kein Treffer"
End If
End With
End If
End Sub
Gruß Werner
Anzeige
AW: Fehler - Änderung
15.02.2019 08:56:46
Christoph
Hallo Werner,
funktioniert fast perfekt!
Aus Datenbank wird aus dem Filter Spalten B-F kopiert, es müssen aber B-G sein.
Habe schon versucht in dem Code die 6 an manchen Stellen in eine 7 zu Verwandeln (sind ja Spalten 2-7), aber es hat nicht geklappt...
Viele Grüße
Christoph
AW: Fehler - Änderung
15.02.2019 09:04:23
Werner
Hallo Christoph,
das liegt daran, dass du den Filter "händisch" nicht bis Spalte G gesetzt hast. Mach den Filter im Blatt einfach mal raus und lass das durch das Makro erledigen.
Gruß Werner
AW: Fehler - Änderung
18.02.2019 08:47:08
Christoph
Hallo Werner,
jetzt funktioniert es!
Allerdings habe ich noch eine Bitte:
Ich habe vermutlich die falsche Zelle zum Vergleich angegeben.
C3 soll verglichen werden mit Spalte E, aktuell vergleicht er mit Spalte F.
Viele Grüße
Christoph
Anzeige
AW: Fehler - Änderung
18.02.2019 09:42:28
Werner
Hallo Christoph,
so:
Sub Filtern()
Dim loLetzte As Long
If Worksheets("Abfrage_Händler").Range("C3")  "" Then
With Worksheets("Datenbank")
loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
If WorksheetFunction.CountIf(.Range(.Cells(2, 5), .Cells(loLetzte, 5)), _
"*" & Worksheets("Abfrage_Händler").Range("C3") & "*") > 0 Then
With Worksheets("Abfrage_Händler")
loLetzte = .Cells(.Rows.Count, 6).End(xlUp).Offset(1).Row
.Range(.Cells(4, 6), .Cells(loLetzte, 11)).ClearContents
End With
If .FilterMode Then .ShowAllData
.Range("B1:G1").AutoFilter Field:=4, Criteria1:="*" & _
Worksheets("Abfrage_Händler").Range("C3") & "*"
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
Worksheets("Abfrage_Händler").Cells(4, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
If .FilterMode Then .ShowAllData
Else
MsgBox "Kein Treffer"
End If
End With
End If
End Sub
Gruß Werner
Anzeige
AW: Fehler - Änderung
18.02.2019 10:17:06
Christoph
Perfekt!!!
Vielen vielen Dank!
Gerne u. Danke für die Rückmeldung. o.w.T.
18.02.2019 10:23:25
Werner

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige