Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro Aufzeichnung zusammen fassen
#1
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!!!
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top
#2
@alle

Hab selber ne Lösung gefunden, mit der ich leben kann.
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top
#3
Hallo Bernd,

könntest Du die Lösung, wo Du jetzt verwendest hier posten?
Gruß Stefan
Win 10 / Office 2016
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste