03.09.2014, 14:04
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:
Vielen Dank schon mal im Voraus!!!
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.
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.