Makro Aufzeichnung zusammen fassen

[Bernie]

Hallo zusammen,

ich benötige mal Hilfe. Kann mir jemand mal meinen VBA-Code, den ich mit Recorder aufgezeichnet habe, zusammen fassen (optimieren). Bekomme das einfach nicht hin.

Hier mein Code:

Code:

Sub aktualisieren()
'
' aktualisieren Makro
'

'
    Sheets("DAX").Select
    Columns("S:U").Select
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:D").ColumnWidth = 0.88
    Selection.Columns.AutoFit
    Columns("E:G").Select
    Sheets("TECDAX").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("H:H").ColumnWidth = 0.88
    Columns("I:K").Select
    Sheets("MDAX").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("L:L").ColumnWidth = 0.88
    Columns("M:O").Select
    Sheets("SDAX").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("P:P").ColumnWidth = 1.33
    Columns("Q:S").Select
    Sheets("DOW JONES").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("U:AA").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("G2:J2").Select
    ActiveWindow.LargeScroll ToRight:=-1
    Range("A2:C2,E2:G2,I2:K2,M2:O2,Q2:S2").Select
    Range("Q2").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434828
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A2:C32,E2:G32,I2:K52,M2:O52,Q2:S32").Select
    Range("Q2").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("A2:B2").Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2")).Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2", "Button 3")).Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2", "Button 3", _
        "Button 4")).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 28.5
    Selection.ShapeRange.Width = 170.25
    Selection.ShapeRange.IncrementLeft -42.75
    Selection.ShapeRange.IncrementTop 3
    Range("W17").Select
    ActiveSheet.Shapes.Range(Array("Button 2")).Select
    ActiveSheet.Shapes.Range(Array("Button 2", "Button 3")).Select
    ActiveSheet.Shapes.Range(Array("Button 2", "Button 3", "Button 4")).Select
    Selection.Delete
    Range("T19").Select
End Sub


Sub fiter_neu()
'
' fiter_neu Makro
'

'
    Range("A2:B2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("E2:F2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "E2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("I2:J2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "I2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("M2:N2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "M2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("Q2:R2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "Q2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("A3:A32").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercent
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 25
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(3).Value = 3
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 65280
        .TintAndShade = 0
    End With
    Range("A3").Select
    Selection.Copy
    Range("E3:E32,I3:I52,M3:M52,Q3:Q32").Select
    Range("Q3").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Sheets("Total").Select
End Sub

Vielen Dank schon mal im Voraus!!!

[Bernie]

@alle

Hab selber ne Lösung gefunden, mit der ich leben kann.

[Steffl]

Hallo Bernd,

könntest Du die Lösung, wo Du jetzt verwendest hier posten?