What's the vba code to change the color of the first line in multiple excel sheets from 6 onwar-CodePudding

I need to format (create a title, select the vendor code according to the table...) a set of cells at the beginning of each sheet from sheet 6. I already have the VBA code to insert the lines above the table, now I just needed the code to format the cells from sheet 6 at the same time. Can anyone help me? My code for inserting lines is as follows:

Sub insert_rows()

Application.DisplayAlerts = False


Dim i As Integer, a As Integer

a = 6

For i = Sheets.Count To 6 Step -1

If Sheets.Count = 6 Then
Exit Sub
End If

a = a   1

    Sheets(i).Range("1:1").Insert
    Sheets(i).Range("2:2").Insert
    Sheets(i).Range("3:3").Insert
    Sheets(i).Range("4:4").Insert
    Sheets(i).Range("5:5").Insert
    Sheets(i).Range("6:6").Insert
    Sheets(i).Range("7:7").Insert
    Sheets(i).Range("8:8").Insert
    
Application.DisplayAlerts = True
Next

End Sub

The formatting I want is the one below. I need the code to apply this formatting from sheet 6 onwards, because the first sheets are support sheets for the tables and, therefore, do not need this "header". Sub Format() ' ' Format Macro

Range("B1:J2").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Selection.Merge
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = True
End With
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249977111117893
    .PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B1:J2").Select
With Selection.Font
    .Color = -10066432
    .TintAndShade = 0
End With
Range("B1:J2").Select
ActiveCell.FormulaR1C1 = "TITLE"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Name:"
Range("B5").Select
ActiveCell.FormulaR1C1 = "Code:"
Range("B6").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("C4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C5").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
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
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
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
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.DisplayGridlines = False

End Sub

Thank you!

CodePudding user response：

How to Get Rid of Select/Activate When Possible

Option Explicit


Sub CreateHeadersAfterSheet5()
    Const ProcName As String = "CreateHeadersAfterSheet5"
    On Error GoTo ClearError
    
    Const FirstWorksheetIndex As Long = 6
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook
        
        Dim LastWorksheetIndex As Long: LastWorksheetIndex = .Worksheets.Count
        If LastWorksheetIndex < FirstWorksheetIndex Then Exit Sub
        
        Dim ash As Object: Set ash = .ActiveSheet
        
        Dim n As Long
        
        For n = FirstWorksheetIndex To LastWorksheetIndex
            CreateHeaders .Worksheets(n)
        Next n
    
        ash.Select
    
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Headers created."

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub


Sub CreateHeaders(ByVal ws As Worksheet)
    Const ProcName As String = "CreateHeaders"
    On Error GoTo ClearError
    
    With ws
        
        .Select ' cannot be avoided only because of the following line
        ActiveWindow.DisplayGridlines = False
    
        .Range("1:8").Insert
        
        With .Range("B1:J2")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            '.MergeCells = True
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.249977111117893
                .PatternTintAndShade = 0
            End With
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            With .Font
                .Color = -10066432
                .TintAndShade = 0
            End With
        End With
        
        .Range("B1").Value = "TITLE"
        
        .Range("B4").Value = "Name:"
        
        .Range("B5").Value = "Code:"
        
        .Range("B6").Value = "Date:"
        
        With .Range("C4")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        
        With .Range("C5")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        
        With .Range("C6")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        
    End With

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub