Attribute VB_Name = "Module2" Sub SZTM_Spielliste() Attribute SZTM_Spielliste.VB_Description = "Formatiert die Spielliste" Attribute SZTM_Spielliste.VB_ProcData.VB_Invoke_Func = "X\n14" ' ' SZTM_Spielliste Macro ' Formatiert die Spielliste ' ' Keyboard Shortcut: Ctrl+Shift+X ' Dim ws As Worksheet For Each ws In ActiveWorkbook.Sheets With ws ws.Activate 'Select first row, change font size, make bold and merge Range("A1:K1").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Selection.Merge With Selection.Font .Name = "Calibri" .Size = 14 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Selection.Font.Bold = True 'Select second row, make bold and merge Range("A2:K2").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Selection.Merge Selection.Font.Bold = True 'Select all data cells, activate grid, fit width, increase height and add header. Range("A4:K4").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.149998474074526 .PatternTintAndShade = 0 End With Selection.Font.Bold = True ActiveWindow.SmallScroll Down:=-3 Range("A4").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.RowHeight = 33.75 Selection.EntireColumn.AutoFit 'Columns("A:A").EntireColumn.AutoFit 'Columns("B:B").EntireColumn.AutoFit 'Columns("C:C").EntireColumn.AutoFit 'Columns("D:D").EntireColumn.AutoFit 'Columns("E:E").EntireColumn.AutoFit End With Next End Sub