Hallo zusammen, ich stehe vor folgendem Problem bei Excel von Office 2013. Ich möchte in einer Excel - Datei die Werte (Arbeitsplatzbezeichnung z.B. 3400 - 3431) aus Spalte F auslesen und per Variable damit Buttons zum Filtern über folgende VBA Script erstellen lassen, welche oben in der Tabelle dargestellt werden (siehe Bild). Bislang habe ich das für den ersten Versuch mit einzelnen Prozeduren händisch erstellen und für viele Arbeitspätze ist mir das zu aufwendig auf dauer.


Folgende Routinen sollen dann den ausgelesenen Arbeitsplatz automatisch übernehmen. (als Platzhalter setze ich jetz mal die Bezeichnung [Wert APLZ] ein)

Sub Buttons()
    
        ActiveSheet.Buttons.Add(104.2, 65.4, 40.2, 23.4).Select
        ActiveSheet.Shapes.Range(Array("Button 3")).Select
        Selection.Characters.Text = "5202"
        With Selection.Characters(Start:=1, Length:=14).Font
            .Name = "Tahoma"
            .FontStyle = "Standard"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 1
        End With
        Selection.OnAction = "Makro5202"
        End With
        
        With ActiveSheet.Buttons.Add(154.2, 65.4, 40.2, 23.4).Select
        ActiveSheet.Shapes.Range(Array("Button 4")).Select
        Selection.Characters.Text = "5203"
       .
       .
       .
    usw.
    Endsub
    
    gewünscht: 
    
        ActiveSheet.Buttons.Add( [fortlaufende Verschiebung in X], 65.4, 40.2, 23.4).Select
        ActiveSheet.Shapes.Range(Array("Button [fortlaufende Nummer] ")).Select
        Selection.Characters.Text = " [Wert APLZ]"
        With Selection.Characters(Start:=1, Length:=14).Font
            .Name = "Tahoma"
            .FontStyle = "Standard"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 1
        End With
        Selection.OnAction = " [Wert APLZ] "
    
    Daraus wird dann folgender Filter aufgerufen:
    
    Bisher: 
    

Sub Makro5202() ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=1 ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=8, Criteria1:=Array("50", "75"), Operator:= _ _ xlFilterValues ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=6, Criteria1:=Array("5202"), Operator:= _ xlFilterValues ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=2, Criteria1:=Array("99", "50"), Operator:= _ _ xlFilterValues End Sub

.

.

.

usw.



Gewünscht:

Sub "[Wert APLZ]" ()
    ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=1
    ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=8, Criteria1:=Array("50", "75"), Operator:= _
     _
    xlFilterValues
    ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=6, Criteria1:=Array("[Wert APLZ]"),  _
     _
    Operator:=xlFilterValues
    ActiveSheet.Range("$A$10:$L$6000").AutoFilter Field:=2, Criteria1:=Array("99", "50"), Operator:= _
     _
    xlFilterValues
    End Sub

Danke für eure Hilfe ;)