Daten dynamisch in neues Blatt kopieren

[Hody72]

4. ja das klingt vernünftig und ist wahrscheinlich auch einfach, wenn ich bis auf die Überschriften vorher alles lösche. 

3. Bläht die Datei halt z.T. extrem auf, weil es schon große Datenmengen sind.

Ich benutze Excel 2019 in einer 32Bit Version und bekomme schon ab und an Probleme mit der Geschwindigkeit. Ich denke die 64bit Version wäre besser oder Excel 2021 das gibts wohl aber so gut wie nicht mehr bzw. teuer oder als zweifelhafter Key. Bietet MS ausser der Möglichkeit mit dem Abo für 365 keine Kaufprodukte mit einmal zahlen mehr an?

[DIZA]

Hallo Hody,

ich hab dir mal was zurechtgestrickt.
Probiere mal und melde dich zurück.
Da ich nicht wusste ob und wo du evtl. einen "passenden Schaltknopf" haben möchtest,
startest du das ganze zur Zeit mit Strg+n  
(aktivierte und zugelassene Makros vorausgesetzt)

---

P.S.
Das sind nicht wirklich so wahnsinnig viele Datenmengen.
Dein Problem der Verarbeitungsgeschwindigkeit vermute ich viel eher bei den vielen bedingten Formatierungen, 
welche du dann auch noch unnütziger Weise für die ganze Spalten (=$BG$2:$BG$1048576) bestimmt hast.

[schauan]

Hallöchen,

mal vier Hinweise

1:
4) Du kannst auch alles löschen und kopierst dann die Überschriften mit (letzteres macht mein code auch)
2:
3) füge nur die Werte ein, oder falls die Formeln gewünscht sind die Formeln (Inhalte einfügen - Formeln fügt auch die Werte ein, wo keine Formeln sind...)
3:
Wenn Du eine intelligente Tabelle nimmst, brauchst Du nichts bis zum Blattende vorzuhalten
4:
Wenn Du die Tabelle bearbeitest (ausschneiden, ausgeschnittene Zellen einfügen, usw.) kann es passieren, dass Deine bed. Formatierung fragmentiert wird und die Datei dadurch weiter anwächst und an Performance verliert.

[Hody72]

1. Die Ausgabeseiten habe einige Spalten ausgeblendet, Denke wenn ich die Überschrift mitkopiere blendet es die ggf. wieder ein

3. was bedeutet intelligente Tabelle und was meinst Du mit bis zum Blattende vorzuhalten

Kann ich wenn ich Markos aufnehme, also z.B. ein Makro für jede Ergebnisseite, nachher die Makros irgendwie verknüpfen oder muss ich dann für 12 Seiten entweder 12 Markos ausführen oder alles in einem Makro aufnehmen?

[schauan]

Hallöchen,

1) beim Kopieren werden ausgeblendete Zeilen oder Spalten nicht übertragen. Allerdings wird z.B. aus dem Original A+C kopiert dann A+B

3) Du markierst Deine Daten und gehst über Einfügen - Tabelle. Dadurch wird die Markierung in eine i.T. / Liste umgewandelt. Mein Code arbeitet mit so einer Tabelle, daher z.B. diese Syntax: With ActiveSheet.ListObjects("Tabelle1")


Du kannst ein Makro dann mit einer Schleife versehen und die 12 Seiten darin abarbeiten. Du musst halt nur schauen, ob das mit Paramatern einfach so geht.
z.B:

For i=1 to 3
Sheets.Add
ActiveSheet.Name = "Tabellelele" & i
'... und noch mehr tun
Next

Das geht aber nur einmal, dann gibt's einen Fehler weil die Blätter schon da sind

Du kannst Parameter, wenn's geht, berechnen oder auch vorab festlegen, z.B.:

arrFarben = Array("rot","gelb","grün")
For i=0 to 2
Sheets.Add
ActiveSheet.Name = "Tabellelele" & arrfarben(i)
'... und noch mehr tun
Next

[Hody72]

Thanks again,

nein ich werde keine neuen Blatter erstellen sondern immer auf bestehende Blätter kopieren.

Ich habe das mal für die Beispieldatei an Hand des Ergbenisblattes LWF gemacht:

Code:

Sub LWF()
'
' LWF Makro
'

'
    Columns("N:N").Select
    Selection.AutoFilter
    ActiveSheet.Range("$N$1:$N$249").AutoFilter Field:=1, Criteria1:="=L", _
        Operator:=xlOr, Criteria2:="=R2"
    ActiveWindow.SmallScroll Down:=-12
    Sheets("LWF").Select
    Rows("2:153").Select
    Selection.ClearContents
    Sheets("Team").Select
    Rows("12:179").Select
    Selection.Copy
    Sheets("LWF").Select
    Rows("2:2").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-27
    Range("AN11").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("LWF").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("LWF").Sort.SortFields.Add2 Key:=Range("N2:N82"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("LWF").Sort
        .SetRange Range("A1:CL82")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

So dass es quasi alles nach der Überschrift löscht (wobei unklar ist wie ich den Bereich relativ markiere, wahrscheinlich mit STRG und Pfeil nach unten, und dann das Basisblatt filtert und danach die Daten rüberkopiert und sortiert.

Das würde ich dann quasi für jedes Blatt machen, was dann wie gesagt 12 Makros wären

[DIZA]

Hab deinen Code mal etwas angepasst.
So ist er dann auch dynamisch.

Code:

Sub LWF()
' LWF Makro
Dim dlz As Long, dls As Long
Team.Activate
dls = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
dlz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    Columns("N:N").AutoFilter
    ActiveSheet.Range("$N$1:$N$" & dlz).AutoFilter Field:=1, Criteria1:="=L", _
        Operator:=xlOr, Criteria2:="=R2"
    Sheets("LWF").Rows("2:500").Delete  'ClearContents
    Sheets("Team").Rows("2:" & dlz).Copy
    Sheets("LWF").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("LWF").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("LWF").Sort.SortFields.Add2 Key:=Range("N2:N82"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
dlz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    With ActiveWorkbook.Worksheets("LWF").Sort
        .SetRange Range("A1:CL" & dlz)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub