Attribute VB_Name = "Module1" Sub SZTM_Zahlliste() Attribute SZTM_Zahlliste.VB_Description = "Formatiert die Zahlliste" Attribute SZTM_Zahlliste.VB_ProcData.VB_Invoke_Func = "F\n14" ' ' SZTM_Zahlliste Macro ' Formatiert die Zahlliste ' ' Keyboard Shortcut: Ctrl+Shift+F ' 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:F1").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:F2").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 price cells and merge Range("C4:F4").Select Selection.Merge 'Select last cell ActiveCell.SpecialCells(xlLastCell).Select Selection.Offset(0, -2).Select Selection.Resize(Selection.Rows.Count + 1, Selection.Columns.Count + 2).Select Selection.Merge Selection.Offset(0, -3).Select Selection.Resize(Selection.Rows.Count + 1, Selection.Columns.Count + 2).Select Selection.Merge Selection.Offset(-1, 0).Select Selection.Font.Bold = True Selection.Offset(0, 1).Select Selection.Resize(Selection.Rows.Count, Selection.Columns.Count + 1).Select Selection.Merge Selection.Offset(0, 1).Select Selection.Font.Bold = True Selection.Offset(0, 1).Select Selection.Resize(Selection.Rows.Count, Selection.Columns.Count + 1).Select Selection.Merge Selection.Offset(-1, -4).Select Selection.Font.Bold = True Selection.Offset(0, 1).Select Selection.Resize(Selection.Rows.Count, Selection.Columns.Count + 1).Select Selection.Merge Selection.Offset(0, -1).Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count).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 'Select all data cells, activate grid, fit width, increase height and add header. Range("A6:F6").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("A6").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Resize(Selection.Rows.Count - 6, Selection.Columns.Count).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