Clever-Excel-Forum

Normale Version: VBA: Kopieren aus gefilterte Tabelle (dynamisch)
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
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
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
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
Und sehe erst jetzt, dass der TE Excel 365 hat.
Das macht vieles einfacher. Wink

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:

ABCDEFGHIJ
1Wertegal1KAT_1egal2KAT_2Top10
2262xCypKategorie:D
3979xDyx979Dx
4303xEyb973Dw
5587xEyn954Di
6213xDyx953Dl
7684xDyb894Dk
8894xDyk846Dn
9973xAyo838Dp
10827xFyd822Dy
11245xEyb684Db
12954xDyi582Dy
13954xAyv
14202xDyc
15953xDyl
16809xFyr

ZelleFormel
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)
Hallöchen,

aber sicher ein paar "André" Smile
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!
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