Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


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 2010 Pro - Win 7 Home Premium
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.
to 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 2010 Pro - Win 7 Home Premium
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.
to top
#3
Hallo Bernd,

könntest Du die Lösung, wo Du jetzt verwendest hier posten?
Gruß Stefan
Win 7 / Office 2007
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  CHAOS: Makro-Schaltflächen rotten sich zusammen :-) Calafati 10 162 07.11.2016, 19:27
Letzter Beitrag: Gast 123
  Wie kann ich in Excel in meiner Tabelle die Daten zusammen fassen? Marcia904 5 377 26.04.2016, 14:41
Letzter Beitrag: Rabe
  Zellen farbl. makieren, wenn sie zusammen addiert 50% eines Betrages X ergeben. Woofer 8 716 10.03.2016, 13:55
Letzter Beitrag: schauan
  Mehrere Formen zusammen fügen Tropheus 10 568 29.02.2016, 21:48
Letzter Beitrag: WillWissen
  Zwei Zahlenkolonne zusammen fügen Roga1966 17 1.528 03.01.2016, 20:28
Letzter Beitrag: Roga1966
  Hallo zusammen LBBR 3 686 08.06.2015, 16:31
Letzter Beitrag: RPP63
  Button: alle Kreuze zusammen assend kopieren Lulu_ 6 1.550 02.02.2015, 14:57
Letzter Beitrag: Lulu_

Gehe zu:


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