formatage en vb feuile

Sub test()

Dim Rg As Range, Sh As Worksheet
Dim Arr(), A As Integer, Elt As Variant

Arr = Array("=MOD(row(A2),3)=0", "=MOD(row(A1),3)=0")

Set Sh = Worksheets("Feuil5") 'Nom feuille à adapter

Application.ScreenUpdating = False
ActiveWindow.ActiveSheet.ResetAllPageBreaks
ActiveSheet.DisplayAutomaticPageBreaks = True

For Each Elt In Arr
    With Sh
        Set Rg = Range("A1:F2500")
        .Range("H1") = ""
        .Range("H2").Formula = Elt
    End With
    
    With Rg
        .AdvancedFilter xlFilterInPlace, Sh.Range("H1:H2")
        If A = 0 Then
            With .Range("_FilterDataBase").Offset(1). _
                Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
                With .Font
                    .Name = "EanT30Rfz"
                    .Size = 36
                End With
            End With
            A = A + 1
        ElseIf A = 1 Then
            With .Font
                .Name = "Comic Sans MS"
                .Size = 18
                .Bold = True
            End With
            A = A + 1
        End If
    End With
Next
For A = 16 To Rg.Rows.Count Step 15
    Sh.HPageBreaks.Add Before:=Sh.Rows(A)
Next
Sh.ShowAllData
Sh.Range("H2") = ""
Application.ScreenUpdating = False
End Sub

Sub test()
 
Dim Rg As Range, Sh As Worksheet, ModeCalcul As Long
Dim Arr(), A As Integer, Elt As Variant, Adr As String

'-------------Variables à définir----------------
Set Sh = Worksheets(ActiveSheet.Name) 'Nom feuille à adapter
'------------------------------------------------

ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Reset_Mise_En_page Sh

Arr = Array("=MOD(row(A2),3)=0", "=MOD(row(A1),3)=0") 

For Each Elt In Arr
     With Sh
        .Range("A2600") = 1
        Set Rg = Range("A1:F2500")
        .Range("H1") = ""
        .Range("H2").Formula = Elt
    End With
     
    With Rg
        .AdvancedFilter xlFilterInPlace, Sh.Range("H1:H2")
        If A = 0 Then
            With .Range("_FilterDataBase").SpecialCells(xlCellTypeVisible)
                With .Font
                    .Name = "EanT30Rfz"
                    .Size = 36
                End With
            End With
            A = A + 1
        ElseIf A = 1 Then
            With .Font
                .Name = "Comic Sans MS"
                .Size = 18
                .Bold = True
            End With
            A = A + 1
        End If
    End With
    Sh.ShowAllData
    DoEvents
Next

For A = 16 To Rg.Rows.Count Step 15
    Sh.HPageBreaks.Add before:=Sh.Rows(A)
Next
With Sh
    .DisplayPageBreaks = True
    .Range("A2600") = ""
    Adr = .UsedRange.Address
    .Range("H2") = ""
    With .Shapes("Bouton 1")
        .Left = Sh.Range("C2").Left
        .Top = Sh.Range("C2").Top
        .Width = Sh.Range("C2:F2").Width
        .Height = Sh.Range("C2:C3").Height
    End With
End With
Application.Calculation = ModeCalcul
Application.ScreenUpdating = True
End Sub
'------------------------------------------------ 
Sub Reset_Mise_En_page(Sh As Worksheet)
Sh.ResetAllPageBreaks
Sh.UsedRange.Style = "Normal"
End Sub