Hallo an alle,
ich bräuchte bitte Hilfe bei einem Makro welches auf den neueren Excel-Version nicht mehr zu laufen scheint. Das Makro wurde damals von einem Kollegen geschrieben, ich selbst habe keine Erfahrung mit VBA.
Sobald man das Makro ausführt, läuft es kurzzeitig und gibt dann den oben genannten Fehler aus aber wie gesagt auf älteren Versionen (2013 zb) läuft es problemlos durch.
Option Explicit
Sub formatierung()
'
' formatierung Makro
'
'
Columns("E:H").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("F:H").Select
Selection.ColumnWidth = 7.43
Columns("A:A").ColumnWidth = 10.14
Columns("D:D").ColumnWidth = 4.57
Columns("Q:Q").ColumnWidth = 37.71
Rows("1:1").Select
Selection.Font.Bold = True
Columns("E:E").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Columns("R:R").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Columns("E:E").Select
Selection.NumberFormat = "#,##0.00 $"
Columns("O:O").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Selection.AutoFilter
Columns("E:E").ColumnWidth = 16.29
Sheets("Tabelle2").Select
Sheets("Tabelle2").Copy After:=Sheets(2)
Sheets("Tabelle2 (2)").Select
Sheets("Tabelle2 (2)").Name = "nur nikotin"
ActiveSheet.Range("$A$1:$T$50000").AutoFilter Field:=18, Criteria1:= _
"Deutschland"
Cells.Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-9
Range("K5").Select
ActiveWindow.SmallScroll Down:=-24
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Tabelle2").Select
Rows("1:1").Select
Selection.Copy
Sheets("nur nikotin").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$50000").AutoFilter Field:=17, Criteria1:="<>*mg*" _
, Operator:=xlAnd
Cells.Select
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 534
ActiveWindow.ScrollRow = 1256
ActiveWindow.ScrollRow = 1601
ActiveWindow.ScrollRow = 5022
ActiveWindow.ScrollRow = 5336
ActiveWindow.ScrollRow = 8223
ActiveWindow.ScrollRow = 8569
ActiveWindow.ScrollRow = 10546
ActiveWindow.ScrollRow = 10703
ActiveWindow.ScrollRow = 12335
ActiveWindow.ScrollRow = 12586
ActiveWindow.ScrollRow = 14187
ActiveWindow.ScrollRow = 14344
ActiveWindow.ScrollRow = 14657
ActiveWindow.ScrollRow = 15222
ActiveWindow.ScrollRow = 15379
ActiveWindow.ScrollRow = 15411
ActiveWindow.ScrollRow = 15505
ActiveWindow.ScrollRow = 15536
ActiveWindow.ScrollRow = 15505
ActiveWindow.ScrollRow = 15473
ActiveWindow.ScrollRow = 15348
ActiveWindow.ScrollRow = 15285
ActiveWindow.ScrollRow = 15191
ActiveWindow.ScrollRow = 14092
ActiveWindow.ScrollRow = 13653
ActiveWindow.ScrollRow = 10766
ActiveWindow.ScrollRow = 10326
ActiveWindow.ScrollRow = 7784
ActiveWindow.ScrollRow = 7533
ActiveWindow.ScrollRow = 5650
ActiveWindow.ScrollRow = 4991
ActiveWindow.ScrollRow = 3798
ActiveWindow.ScrollRow = 3421
ActiveWindow.ScrollRow = 3045
ActiveWindow.ScrollRow = 2511
ActiveWindow.ScrollRow = 2386
ActiveWindow.ScrollRow = 1946
ActiveWindow.ScrollRow = 1852
ActiveWindow.ScrollRow = 1570
ActiveWindow.ScrollRow = 1507
ActiveWindow.ScrollRow = 1413
ActiveWindow.ScrollRow = 1287
ActiveWindow.ScrollRow = 1068
ActiveWindow.ScrollRow = 1005
ActiveWindow.ScrollRow = 879
ActiveWindow.ScrollRow = 785
ActiveWindow.ScrollRow = 691
ActiveWindow.ScrollRow = 597
ActiveWindow.ScrollRow = 471
ActiveWindow.ScrollRow = 440
ActiveWindow.ScrollRow = 346
ActiveWindow.ScrollRow = 252
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 1
Selection.Delete Shift:=xlUp
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C39").Select
Sheets("Tabelle2").Select
Rows("1:1").Select
Selection.Copy
Sheets("nur nikotin").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("Q1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$20000").AutoFilter Field:=17, Criteria1:= _
"=*0 mg*"
Cells.Select
Selection.Delete Shift:=xlUp
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
Sheets("Tabelle2").Select
Rows("1:1").Select
Selection.Copy
Sheets("nur nikotin").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 2
Range("U1").Select
ActiveCell.FormulaR1C1 = "Summe"
Range("U2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]*RC[-5]"
Range("U2").Select
Selection.AutoFill Destination:=Range("U2:U20000")
Range("U2:U20000").Select
Columns("U:U").Select
Selection.NumberFormat = "#,##0.00 $"
Selection.Font.Bold = False
Columns("U:U").Select
Selection.Font.Bold = True
Range("U2").Select
End Sub
|