vba Adding worksheets with the same format (workbook - link - upload)

[montecarlo2012]

Hi all.
On sheet 4 I have a format on column A, start with number 1.
What I want is to create 53 worksheets
Starting on sheet4 as first one, then
sheet 5 will have the same format

" except "
the cells "A1" on sheet 5 will display number 2
the cells "A1" on sheet 6 will display number 3
and so on until the sheet 53
this is the link with my workbook

Book1.xlsx

Microsoft Excel Workbook

1drv.ms

and in this workbook you will see the code

Sub report_INTERVALS()

    Dim SrcWS As Worksheet, DestWS As Worksheet
    Dim rngData As Range, cell As Range, M, N
    Dim rngDest As Range, i As Long
    
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    Set SrcWS = Sheet3 ':::::::::::::::::::::::::::::::::::::::DATA SOURCE
    Set DestWS = Sheet4 '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::DISPLAY REPORT 1 ::::::::::::::::::LOOP HERE

    Set rngDest = DestWS.Range("C2")
    
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    For i = 0 To 5
        Set rngData = SrcWS.Range(SrcWS.Cells(2, 2 + i), SrcWS.Cells(SrcWS.Rows.Count, 2 + i).End(xlUp))
        M = -1
        For Each cell In rngData
        
 '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
            If cell = 1 Then  '::::::::::::::::::::::::::::::::::::::::::::::::::::REPORT 1::::::::::::::::::::::::::::"LOOP HERE"
            
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

                rngDest.Offset(0, M) = N
                N = 0
                M = M + 1
            Else
                N = N + 1
            End If
        Next cell
        
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
        
        Set rngDest = rngDest.Offset(16)
    Next i
Dim V, Rg As Range
    With Application
        For Each V In Split("B2 B18 B34 B50 B66 B82")
            Set Rg = Range(V, Range(V).End(xlToRight))
            Range(V)(3).Resize(4).Value2 = .Transpose(Array(.Average(Rg), .Count(Rg), .Max(Rg), .Mode(Rg)))
        Next
    End With
            Set Rg = Nothing

'LOOP HERE

'::::::::::::::::::::::::::::::::::::::::::B2::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B8").Formula = "=COUNTIF(B2:XX2,B7)" 'QTY MODE
Range("B9").Formula = "=COUNTIF(B2:XX2,B2)"   'QTY LAST
':::::::::::::::::::::::::::::::::::::::::: C 18:::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B24").Formula = "=COUNTIF(B18:XX18,B17)" 'QTY MODE
Range("B25").Formula = "=COUNTIF(B18:XX18,B18)"   'QTY LAST
':::::::::::::::::::::::::::::::::::::::::::D34::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B40").Formula = "=COUNTIF(B34:XX34,B33)" 'QTY MODE
Range("B41").Formula = "=COUNTIF(B34:XX34,B34)"   'QTY LAST
'.::::::::::::::::::::::::::::::::::::::::E50::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B56").Formula = "=COUNTIF(B50:XX50,B49)" 'QTY MODE
Range("B57").Formula = "=COUNTIF(B50:XX50,B50)"   'QTY LAST
'::::::::::::::::::::::::::::::::::::::::::F66::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B72").Formula = "=COUNTIF(B66:XX66,B65)" 'QTY MODE
Range("B73").Formula = "=COUNTIF(B66:XX66,B66)"   'QTY LAST
':::::::::::::::::::::::::::::::::::::::::::G82:::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B88").Formula = "=COUNTIF(B82:XX82,B81)" 'QTY MODE
Range("B89").Formula = "=COUNTIF(B82:XX82,B82)"   'QTY LAST
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::CHECK THE HIGHTEST ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'LOOP HERE

Sheet3.Range("L4").Value = Sheet4.Range("B50").Value 'LAST SHOW
Sheet3.Range("N4").Value = Sheet4.Range("B55").Value  'MODE
Sheet3.Range("O4").Value = Sheet4.Range("B56").Value  'PRINT QTY  MODE
Sheet3.Range("k4").Value = Sheet4.Range("B57").Value  'PRINT QTY LAST

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Dim ws As Worksheet
Dim ColorRng As Range
Dim ColorCell As Range

Set ws = Worksheets("Sheet4") ' LOOP HERE
Set ColorRng = ws.Range("B5,B21,B37,B53,B69,B85")
For Each ColorCell In ColorRng
If ColorCell.Value = Application.WorksheetFunction.Max(ColorRng) Then
ColorCell.Interior.Color = RGB(10, 140, 210)

End If
Next

  End Sub

I want the condition If cell = 1 Then '::::::::::::::::::::::::::::::::::::::::::::::::::::REPORT 1:::::::::::::::::::::::::::: be equal to the cell A1 of each sheet and display in that sheet
thank you for reading this

 

[montecarlo2012]

Yes Sir, Your code populate as many sheets as I want and display any format or legend I putting in the master sheet, thank you for that and for the many times you upgrade my knowledge.
I really appreciate your kindness,