Makro "allgemeingültig" machen

[Calafati]

Hallo zusammen und ein verspätetes FROHES NEUES,

nachdem ich mit dem VBA-Recorder anhand einer Beispieltabelle ein Makro erstellt habe, läuft dieses nach Neustart in einer anderen Tabelle nicht und wenn ich mir den Code anschaue

ActiveWorkbook.Worksheets("Bestellungen-31.12.2021").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Bestellungen-31.12.2021").Sort.SortFields.Add2 Key _
        :=Range("C2:C176"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Bestellungen-31.12.2021").Sort


wird selbst mir als Laien klar, daß das nicht funktionieren kann, wenn die neue  Bestelltabelle ein anderes Datum trägt 

Kann mir jemand verraten, wie ich die betreffenden Zeilen ersetzen muss, um das Makro allgemeingültig abrufen zu können, beziehungsweise ob ich noch an anderer Stelle (die mir jetzt nicht ersichtlich ist) etwas ersetzen muss?

Eine Frage noch zum RANGE (die Beispieltabelle, in der auch sortiert wird, hatte nur 176 Zeilen, es können aber durchaus auch 500 sein): kann man das beliebig erweitern, bspw. auf 1000 Zeilen, um immer "gerüstet zu sein"?!

Lieben Dank
Gruß
Klaus

[Kuwer]

Hallo Klaus,

Code:

Range("C2").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes

Gruß Uwe

[Gast 123]

Hallo

es gibt zwei simple Lösungen um das Makro Universel zu gestalten.  Über eine With Klammer mit ActiveSheet oder man lädt den Namen des Aktiven Sheets in eine Variable.
Die With Klammer verkürzt die Schreibweise, man darf aber NIE den Punkt vor allen Range und Cells vergessen! Der Punkt besagt das sich diese Bereiche auf With beziehen. 
Man kann auch den Blatt Namen vorher in eine Öffentliche Public Variable laden und das gewünschte Blatt das sortiert werden soll beim Makro Start definiert festlegen.
Das wäre siinnvoll wenn die Sortierroutine von mehreren Makros gestartet werden soll und die gleiche Sortierroutine für mehrere Blätter gültig ist.

mfg Gast 123

Code:

Sub test()
Dim Sht As String, lz1 As Long
Sht = ActiveSheet.Name
With ActiveWorkbook.Worksheets(Sht)
    'LastZell in Spalte A=1 suchen
    lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
    .Sort.SortFields.Clear   'lz1 für den Bereich einsetzen
    .Sort.SortFields.Add2 Key:=Range("C2:C" & lz1), SortOn:=xlSortOnValues, _
     Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
         .Range ("A2:xxx" & lz1)
    End With
End With
End Sub


Sub test2()
With ActiveSheet
    'ab hier gleiche Prozedur wit oben!!
End With
End Sub

[RPP63]

Moin!
Warum wird die hier völlig ausreichende Range.Sort-Methode von Uwe "verschlimmbessert"?
By the way:
Kennt jemand einen Fall, in dem die "neue" Worksheet.Sort-Methode benötigt wurde?
(die es übrigens im Excel 2003 von Gast 123 noch gar nicht gab)

Gruß Ralf

[schauan]

Auch Moin, Ralf

Warum wird die hier völlig ausreichende Range.Sort-Methode von Uwe "verschlimmbessert"?

manchmal ergibt sich so was mangels der Kenntnis der vorherigen Antwort einfach nur

[Gast 123]

Hallo

Sorry an Uwe, seine Antwort habe ich offenbar völlig übersehen.  Die ist wirklich genial einfach, Hochachtung vor seinem Wissen!

mfg Gast 123

[Calafati]

Ich habe definitiv Hochachtung VOR EUCH ALLEN!!!

Leider kann ich als Laie nicht halb so gut mit den von Euch genannten Begrifflichkeiten (With-Klammer, Variable laden etc.) umgehen und habe daher einmal das komplette Makro angehängt
Wenn ihr mir dort vielleicht die beiden Lösungen im Hinblick auf den "variablen Range" und vor allem die allgemeine Benutzbarkeit "einbauen" könntet?!?

Fakt ist: dieses Makro wird nur für eine Tabelle benutzt, die ich jeden Tag im gleichen Format/Layout, lediglich in unterschiedlicher Länge, versehen mit unterschiedlichen Bewegungsdaten und natürlich betitelt mit einem anderen Namen bekomme.


Ich sage mal megalieben Dank und wünsche allen ein schönes Wochenende!

Viele Grüße
Klaus




Sub NORMALEBESTELLUNG()
'
' NORMALEBESTELLUNG Makro
'
'
    Columns("A:A").Select
    Selection.ColumnWidth = 19
    Columns("B:B").Select
    Selection.ColumnWidth = 23
    Columns("C:C").Select
    Selection.ColumnWidth = 30
    Columns("D:D").Select
    Selection.ColumnWidth = 2
    Columns("E:E").Select
    Selection.ColumnWidth = 17
    Columns("F:F").Select
    Selection.ColumnWidth = 24
    Range("G:G,I:I,J:J").Select
    Range("J1").Activate
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Übergabe"
    Range("G2").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SmallScroll Down:=-12
    Range("C2:C500").Select
    ActiveWorkbook.Worksheets("Bestellungen-11.01.2022").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Bestellungen-11.01.2022").Sort.SortFields.Add2 Key _
        :=Range("C2:C370"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Bestellungen-11.01.2022").Sort
        .SetRange Range("A1:G370")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A8").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

[Gast 123]

Hallo

ich habe mir erlaubt den Code mal zu bereinigen, viel kürzer wurde er aber nicht, bedingt durch die Druckereinstellungen. Die lassen sich nicht reduzieren.
Nur den Teil am Anfang, habe ich in ein neues Makro geschrieben. Die Spalten werden sich in der Breite ja nicht verändern, das stellt man einmal ein, fertig.

mfg  Gast 123

Code:

Sub NORMALEBESTELLUNG()
' NORMALEBESTELLUNG Makro
    'Spalten G,I,J löschen
    Range("G:G,I:J").Delete Shift:=xlToLeft
    'Text in Zelle G1 neu einschreiben
    Range("G1").Value = "Übergabe"
   
    'Printer Einstellungen
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
   
    'Tabelle Bestellungen 2022 Bereich A1:G370 sortieren
    With ActiveWorkbook.Worksheets("Bestellungen-11.01.2022")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("C2:C370"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:G370")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    'Druckerausgabe: 1 Kopie
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub



Sub Spaltenbreite_einstellen()
    Columns("A").ColumnWidth = 19
    Columns("B").ColumnWidth = 23
    Columns("C").ColumnWidth = 30
    Columns("D").ColumnWidth = 2
    Columns("E").ColumnWidth = 17
    Columns("F").ColumnWidth = 24
End Sub

[RPP63]

Moin!
Ich fange mal an:
Denkbar, dass Du zunächst mal alle Spaltenbreiten optimieren willst.
Das geht so:

Code:

ActiveSheet.Columns.AutoFit

Das ganze .PageSetup-Gedöns ist ohnehin flüssiger als Wasser, denn schließlich wird da kaum eine tägliche Änderung nötig sein!
In G1 steht IMMER Übergabe, dafür braucht es niemals nie ein Makro!
Zum Spalten-Löschen schrieb Gast 123 ja bereits etwas.

Zum Rest hatte Uwe (zum Glück!) minimalistisch die Range.Sort-Methode genannt.
Sollte reichen …
Für den Ausdruck verwendet ein Windows-User seit Äonen schlicht Strg+P
Wer es mag, kann dies auch "programmieren":

Code:

ActiveSheet.PrintOut

Gruß Ralf