AW: Für jedes Worksheet in Workbook
03.03.2016 12:21:09
Larissa
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Range("J1").Select
ws.Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Range("J1").Select
ActiveCell.FormulaR1C1 = "Datum"
ws.Range("L1:AR2").Select
Selection.Copy
ws.Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ws.Range("L1:AR2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ws.Range("L1").Select
ActiveCell.FormulaR1C1 = "Stundenlohn"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ws.Range("M1").Select
ActiveCell.FormulaR1C1 = "Bonus"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ws.Range("N1").Select
ActiveCell.FormulaR1C1 = "Auszahlung"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ws.Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ws.Range("L4").Select
ws.Columns("L:L").ColumnWidth = 14
ws.Columns("L:L").ColumnWidth = 15.29
ws.Range("L2").Select
lz = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Rows.Row
For x = lz To 2 Step -1
If ws.Range("B2").Value = ws.Range("A" & x).Value Then
ws.Range("L2").Value = ws.Range("B" & x).Value
ws.Range("M2").Value = ws.Range("C" & x).Value
End If
Next
ws.Range("H3").Select
ActiveCell.FormulaR1C1 = "=LEFT(R[-1]C,2)&"",""&RIGHT(R[-1]C,2)"
ws.Range("H4").Select
ActiveCell.FormulaR1C1 = "=ROUNDUP(R[-1]C/5,1)*5"
ws.Range("N2").Select
ws.Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=""ja"",(RC[-2]*R[2]C[-6])+R[2]C[-6],RC[-2]*R[2]C[-6])"
ws.Range("M3").Select
Next
Laufzeitfehler '1004':
Die Select-Methode des Range-Objektes konnte nicht ausgeführt werden.
Fehler tritt bei "ws.Columns("J:J").Select" auf.