VBA: Kopieren aus gefilterte Tabelle (dynamisch)

[malevilend]

Hallo zusammen, 

ich suche nach einer Lösung auf ein VBA-Problem. Das Makro soll aus einer Tabelle die 10 größten Positionen herausziehen. Dafür wird zuerst nach der Kategorie gefiltert, danach absteigend sortiert und anschließend - jetzt kommt der kritische Punkt - die Top 10 markiert und kopiert (usw.). Das Makro habe ich aufgezeichnet und stelle nun fest, dass Excel IMMER D53:D62,CL53:CM62 (unten in fett markiert) herauskopiert. Excel soll aber nur die Top 10 markieren, also die ersten 10 Zeilen rauskopieren, die zu sehen sind.
Online habe ich gesehen, dass man dies mit "activecell.row" lösen könnte. Jedoch komm ich hier an meine Grenzen, da ja nicht die komplette Zeile, sondern nur 3 Zellen aus einer Spalte markiert werden sollen, wie ihr seht -> D53:D62,CL53:CM62. Die Top 10 werden immer in den Zeilen 5 bis 14 ausgespuckt. Wie kann man das lösen?

Anbei einen Ausschnitt aus dem VBA Code.


ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter Field:=3, Criteria1:= _
        "Kategorie 1"
    Range("D55").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Abw. Werk 0012").ListObjects("Tabelle1").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Abw. Werk 0012").ListObjects("Tabelle1").Sort. _
        SortFields.Add2 Key:=Range("Tabelle1[[#All],[Betrag]]"), SortOn _
        :=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabellenblatt 1").ListObjects("Tabelle1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D53:D62,CL53:CM62").Select
    Range("CL53").Activate
    Selection.Copy

Vielen Dank im Voraus und beste Grüße,

Maximilian

[Gast 123]

Hallo

mit With Klammer kann man den Code eleganter schreiben, die Recorder Aufzeichnung verbessern.
Wie ich sehe musstest du nur die Zeilenangabe ändern, und den Zielbereich angeben. Wenn du in ein anderes Blatt kopierst geht das Ohne Blatt Select, indem du das Blatt vor Range mit angibst. Auf das übliche Selektieren von Range und Sheets wie im Recorder Code kannst du verzichten. Ohne Select klappt es besser.

mfg Gast 123

Code:

Sub test()
    ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter Field:=3, Criteria1:="Kategorie 1"
    Application.CutCopyMode = False
    With ActiveWorkbook.Worksheets("Abw. Werk 0012").ListObjects("Tabelle1")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("Tabelle1[[#All],[Betrag]]"), SortOn:= _
         xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With .Sort
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
        End With
    End With
   
    Range("D5:D14,CL5:CM14").Copy
    Range("Zieladresse").PasteSpecial xlPasteAll   'oder mit Sheets Zieltabelle
    Worksheets("Zieltabelle").Range("Zieladresse").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End Sub

[RPP63]

Moin!
Nutze den Top-10-Filter und kopiere SpecialCells(xlCellTypeVisible)
Edit:
Bin jetzt doch etwas überrascht.
Der Top-10-Filter funktioniert nicht für ein vorheriges Filtrat, sondern "zieht" nur die sichtbaren aus allen 10.

Gruß Ralf

[RPP63]

Und sehe erst jetzt, dass der TE Excel 365 hat.
Das macht vieles einfacher.

Spalte A Zufallszahlen 100 bis 999
Spalte C die Buchstaben A bis F
Spalte E die Buchstaben a bis z
Spalten B und D sind nicht relevant!

Dann ist es eine einzige Formelzelle:

	A	B	C	D	E	F	G	H	I	J
1	Wert	egal1	KAT_1	egal2	KAT_2		Top	10
2	262	x	C	y	p		Kategorie:	D
3	979	x	D	y	x			979	D	x
4	303	x	E	y	b			973	D	w
5	587	x	E	y	n			954	D	i
6	213	x	D	y	x			953	D	l
7	684	x	D	y	b			894	D	k
8	894	x	D	y	k			846	D	n
9	973	x	A	y	o			838	D	p
10	827	x	F	y	d			822	D	y
11	245	x	E	y	b			684	D	b
12	954	x	D	y	i			582	D	y
13	954	x	A	y	v
14	202	x	D	y	c
15	953	x	D	y	l
16	809	x	F	y	r

Zelle	Formel
H3	=INDEX(SORTIEREN(FILTER(A:E;C:C=H2);;-1);SEQUENZ(H1);{1.3.5})

Gruß Ralf
(wohl wissend, dass der TE hier wohl nicht mehr reinschaut)

[schauan]

Hallöchen,

aber sicher ein paar "André"

[malevilend]

Der TE ist doch wieder zurück! 

Danke euch für die Ideen. Zur Klärung: das Problem konnte ich mit SpecialCells(xlCellTypeVisible) lösen, aber musste einen kleinen Umweg machen.
Nachdem die Tabelle gefiltert wurde, kann man den Top10-Filter nicht verwenden, da er allein auf die Zahlen schaut.

Nachdem mein Makro die Filter gesetzt hat, passiert das:

Range("D5:D20000,CL5:CM20000").SpecialCells(xlCellTypeVisible).Copy
    Sheets("Hilfstabelle").Select

    ActiveSheet.Paste

    Range("A1:C10").Copy

    Range("A1:C20000").Select

   



   

    Sheets("Top 10").Select

    Range("D18").Select
    ActiveSheet.Paste



Das Programm zieht also 20000 Zeilen (die sichtbar sind) in eine Hilfstabelle und kopiert dann die ersten 10 Positionen. Danach sind die 10 Positionen im Clipboard und werden bequem in den Reiter "Top 10" eingefügt :)

Um es kurz zu fassen: es funktioniert!

[Gast 123]

Hallo

schau bitte mal wie dein Code mit dieser Variante läuft.  Vor allem macht es die Datei kleiner, weil ich die Hilfstabelle ab Zeile 15 wieder lösche!
Die Top Ten kannst du dann immer noch in der Hilfstabelle sehen.

mfg  Gast 123

Code:

Range("D5:D20000,CL5:CM20000").SpecialCells(xlCellTypeVisible).Copy
Sheets("Hilfstabelle").Range("A10").PasteSpecial xlPasteValues

'Top Ten direkt sortieren  OHNE Select Sheet
Sheets("Hilfstabelle").Range("A1:C10").Copy _
Sheets("Top 10").Range("D18")

'Hilfstabelle wieder löschen  (bläht sonst die Datei unnnötig auf!!
Sheets("Hilfstabelle").Rows("15:" & Rows.Count).Delete