Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
896to900
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
896to900
896to900
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nach mehr als 2 Werten Filtern und kopieren

Nach mehr als 2 Werten Filtern und kopieren
17.08.2007 16:03:21
Thomas

Hallo ich habe ein 2 kleine Probleme,
ich will Werte aus einer Tabelle filtern nur leider kann ich nur 2 Werte definieren, es sind aber 31 zu berücksichtigen (und diese wären dann noch variabel - deshalb die "Felddefinitionen").
Wenn ich dann die gefilterten Werte kopiere und in einem anderen Blatt per -Inhalte einfügen- "WERTE" einfügen will, dann kopiert er alles also auch die Werte die "weggefiltert" sind mit....
Vielleicht weiß von euch einer eine Lösung....
Danke im vorraus...
Hier meine bisherige Arbeit:

Sub Auswahl()
Set Sammler = Sheets("Sammler")
Set Ziel = Sheets("Ziel")
'Felddefinitionen
F1 = Cells(19, 2)
F2 = Cells(20, 2)
F3 = Cells(21, 2)
F4 = Cells(22, 2)
F5 = Cells(23, 2)
F6 = Cells(24, 2)
F7 = Cells(26, 2)
F8 = Cells(27, 2)
F9 = Cells(28, 2)
F10 = Cells(29, 2)
F11 = Cells(30, 2)
F12 = Cells(31, 2)
F13 = Cells(32, 2)
F14 = Cells(33, 2)
F15 = Cells(34, 2)
F16 = Cells(35, 2)
F17 = Cells(36, 2)
F18 = Cells(37, 2)
F19 = Cells(38, 2)
F20 = Cells(39, 2)
F21 = Cells(40, 2)
F22 = Cells(41, 2)
F23 = Cells(42, 2)
F24 = Cells(43, 2)
F25 = Cells(44, 2)
F26 = Cells(45, 2)
F27 = Cells(46, 2)
F28 = Cells(47, 2)
F29 = Cells(48, 2)
F30 = Cells(49, 2)
F31 = Cells(50, 2)
'StartBlatt waehlen
Sammler.Activate
'Filterprozess
'Auswahl
letzte = Cells(Rows.Count, 40).End(xlUp).Row + 1
'Filter
Range("AN7").Select
Selection.AutoFilter Field:=1, Criteria1:=F4, Operator:=xlOr, Criteria2:=F2
'Auswahl
Range(Cells(letzte, 40), Cells(8, 33)).Select
'Auswahl Kopieren
Selection.Copy
'Zielanwahl
Ziel.Activate
Range("A:AA").Clear
Range("A1").Select
'Schreiben
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Kopierspeicher loeschen
Range("A1").Select
Selection.ClearContents
'Zurueck
Sammler.Activate
Range("AN7").Select
Selection.AutoFilter Field:=1
End Sub


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nach mehr als 2 Werten Filtern und kopieren
17.08.2007 16:35:32
Klaus
Hallo Thomas,
nur die sichtbaren Zellen erhälst du mit
Range(Cells(letzte, 40), Cells(8, 33)).SpecialCells(xlCellTypeVisible).Copy
Außerdem solltest du auf die Befehle "select" und "activate" verzichten, sie sind unnötig und verlangsamen den Code.
Der Autofilter kann - meines wissens nach - nur 2 oder 3 Filterkriterien auf einmal. Für deine umfangreiche Filterung währ ein angepasster VBA-Code angebracht, aber dafür müsste man den Blattaufbau kennen.

Sub test()
'    Set Sammler = Sheets("Sammler")
'    Set Ziel = Sheets("Ziel")
'Felddefinitionen
F1 = Cells(19, 2)
F2 = Cells(20, 2)
F3 = Cells(21, 2)
F4 = Cells(22, 2)
F5 = Cells(23, 2)
F6 = Cells(24, 2)
F7 = Cells(26, 2)
F8 = Cells(27, 2)
F9 = Cells(28, 2)
F10 = Cells(29, 2)
F11 = Cells(30, 2)
F12 = Cells(31, 2)
F13 = Cells(32, 2)
F14 = Cells(33, 2)
F15 = Cells(34, 2)
F16 = Cells(35, 2)
F17 = Cells(36, 2)
F18 = Cells(37, 2)
F19 = Cells(38, 2)
F20 = Cells(39, 2)
F21 = Cells(40, 2)
F22 = Cells(41, 2)
F23 = Cells(42, 2)
F24 = Cells(43, 2)
F25 = Cells(44, 2)
F26 = Cells(45, 2)
F27 = Cells(46, 2)
F28 = Cells(47, 2)
F29 = Cells(48, 2)
F30 = Cells(49, 2)
F31 = Cells(50, 2)
'StartBlatt waehlen
With Sheets("Sammler")
'Auswahl
letzte = .Cells(Rows.Count, 40).End(xlUp).Row + 1
'Filter
.Range("AN7").AutoFilter Field:=1, Criteria1:=F4, Operator:=xlOr, Criteria2:=F2
'Auswahl Kopieren
.Range(Cells(letzte, 40), Cells(8, 33)).SpecialCells(xlCellTypeVisible).Copy
'Zielanwahl
End With
With Sheets("Ziel")
.Range("A:AA").Clear
'Schreiben
.Range("A1").Selection.PasteSpecial Paste:=xlPasteValues
'Kopierspeicher loeschen
.Range("A1").ClearContents
'Zurueck
End With
Sheets("Sammler").Range("AN7").AutoFilter Field:=1
End Sub


Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige