Das ist das ganze Makro, geht das bei dir auch?
Sub Teil_1()
' Teil_1 Makro
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Range("L1").Select
ActiveCell.FormulaR1C1 = "Datum"
Columns("D:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("C:C").Select
Application.DisplayAlerts = False
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Columns("H:M").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=15
Columns("S:Y").Select
Selection.EntireColumn.Hidden = True
Columns("P:Q").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.LargeScroll ToRight:=-1
Columns("C:E").Select
Range("E1").Activate
Selection.EntireColumn.Hidden = True
Columns("O:O").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
Range("AC1").Select
ActiveCell.FormulaR1C1 = "Service Logistik"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "Logistik"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "Kasse"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Kasse Einarb"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Lohnkosten inkl Zuschläge"
Columns("AC:AH").Select
Columns("AC:AH").EntireColumn.AutoFit
Range("A1:AG1").Select
Range("AG1").Activate
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("AG1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Dim LR%, S1%, S2%, Myrange As Range
LR = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
S1 = 2 'erste Spalte für Änderungen
S2 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column '
Set Myrange = Range(Cells(1, S1), Cells(LR, S2)).SpecialCells(xlCellTypeBlanks)
Myrange.Formula = "0"
Range([AC2], [AC2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-25]=10,14.05*RC[-11]+( _
RC[-3]*0.25*14.05)+(RC[-2]*0.25*14.05)+(RC[-1]*0.5*14.05),0)"
Range([AD2], [AD2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-26]=20,14.05*RC[-12]+( _
RC[-4]*0.25*14.05)+(RC[-3]*0.25*14.05)+(RC[-2]*0.5*14.05),0)"
Range([AE2], [AE2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-27]=30,14.4*RC[-13]+(RC[ _
-5]*0.25*14.4)+(RC[-4]*0.25*14.4)+(RC[-3]*0.5*14.4),0)"
Range([AF2], [AF2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-28]=40,14.05*RC[-14]+( _
RC[-6]*0.25*14.05)+(RC[-5]*0.25*14.05)+(RC[-4]*0.5*14.05),0)"
Range([AG2], [AG2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=RC[-4]+RC[-3]+RC[-2]+RC[-1]"
Range("AC2:AG" & Cells(Rows.Count, 33).End(xlUp).Row).NumberFormat = "#,##0.00 "
Range("Z2:Ab" & Cells(Rows.Count, 29).End(xlUp).Row).Replace What:="", Replacement:="0", _
LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
Dim Spalte As Integer
Spalte = 6
With Range(Cells(6, Spalte), Cells(Cells(65536, Spalte).End(xlUp).Row, Spalte))
.Sort Key1:=Columns(Spalte), Order1:=xlAscending
End With
Spalte = 1
With Range(Cells(1, Spalte), Cells(Cells(65536, Spalte).End(xlUp).Row, Spalte))
.Sort Key1:=Columns(Spalte), Order1:=xlAscending
End With
Spalte = 14
With Range(Cells(14, Spalte), Cells(Cells(65536, Spalte).End(xlUp).Row, Spalte))
.Sort Key1:=Columns(Spalte), Order1:=xlAscending
End With
Spalte = 15
With Range(Cells(15, Spalte), Cells(Cells(65536, Spalte).End(xlUp).Row, Spalte))
.Sort Key1:=Columns(Spalte), Order1:=xlAscending
End With
With ActiveWorkbook.Worksheets("Tabelle1").Sort
Dim bereich As Range
Set bereich = Range("A2:AG" & Range("AG65536").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("AC:AG").Select
Selection.ColumnWidth = 10.43
Range("F3").Select
ActiveWindow.DisplayZeros = False
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Selection.Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(29, 30, 31 _
, 32, 33), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Columns("AC:AF").Select
Selection.Columns.Group
ActiveWindow.LargeScroll ToRight:=-1
Range("A2").Select
End
End Sub