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

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
763
Office Version
  1. 2010
Platform
  1. Windows
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

and in this workbook you will see the code
VBA 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
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,301
Office Version
  1. 2010
Platform
  1. Windows
Hi !​
On sheet 4 I have a format on column A
In your attachment there is only Sheet1 : typo or missing worksheet ?​
And there is no code 'cause it's a .xlsx workbook, next time save it as binary .xlsb ….​
 
Last edited:

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
763
Office Version
  1. 2010
Platform
  1. Windows
Thank you Sir.
I already did the change
intervalreport.xlsb

I am new on handling onedrive so, here it is the code:
VBA Code:
Sub s52_51()
'I would like to avoid copy and paste this code 53 times

    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 = Sheet1
    Set DestWS = Sheet52
    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 = 51 Then  '::::::::this is the number to change on every sheet.

                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

'::::::::::::::::::::::::::::::::::::::::::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
Dim ws As Worksheet
Dim ColorRng As Range
Dim ColorCell As Range
Set ws = Worksheets("Sheet52") ' this number also need to be in a loop
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(255, 153, 0)
End If
Next
Range("B15").Formula = "=IF(B2>=B7,""NO"",""YES"")"
Sheet1.Range("Y52").Value = Sheet52.Range("B15").Value 'B

Range("B31").Formula = "=IF(B18>=B23,""NO"",""YES"")"
Sheet1.Range("Z52").Value = Sheet52.Range("B31").Value 'C

Range("B47").Formula = "=IF(B34>=B39,""NO"",""YES"")"
Sheet1.Range("AA52").Value = Sheet52.Range("B47").Value 'D

Range("B63").Formula = "=IF(B52>=B55,""NO"",""YES"")"
Sheet1.Range("AB52").Value = Sheet52.Range("B63").Value 'E

Range("B79").Formula = "=IF(B66>=B71,""NO"",""YES"")"
Sheet1.Range("AC52").Value = Sheet52.Range("B79").Value 'AC=F/52

Range("B95").Formula = "=IF(B82>=B87,""NO"",""YES"")"
Sheet1.Range("AD52").Value = Sheet52.Range("B95").Value 'AD=G/52
'::::::::::::::::::::::decision table 2 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Range("B14").Formula = "=if(B9=1,""yes"",""no"")"
Sheet1.Range("J52").Value = Sheet52.Range("B14").Value

Range("B30").Formula = "=if(B25=1,""yes"",""no"")"
Sheet1.Range("k52").Value = Sheet52.Range("B30").Value

Range("B46").Formula = "=if(B41=1,""yes"",""no"")"
Sheet1.Range("L52").Value = Sheet52.Range("B46").Value

Range("B62").Formula = "=if(B57=1,""yes"",""no"")"
Sheet1.Range("M52").Value = Sheet52.Range("B62").Value

Range("B78").Formula = "=if(B73=1,""yes"",""no"")"
Sheet1.Range("N52").Value = Sheet52.Range("B78").Value

Range("B94").Formula = "=if(B89=1,""yes"",""no"")"
Sheet1.Range("O52").Value = Sheet52.Range("B94").Value
End Sub
just in case is possible any help, thanks.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,301
Office Version
  1. 2010
Platform
  1. Windows
What I want is to create 53 worksheets
Starting on sheet4 as first one, then
sheet 5 will have the same format
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
VBA Code:
Sub Demo0()
    Dim S%
        Application.ScreenUpdating = False
    For S = 2 To 50
            Sheet4.Copy , Sheets(Sheets.Count)
        With ActiveSheet
            .[A1].Value2 = S
            .Name = "Sheet" & S + 3
        End With
    Next
        Application.ScreenUpdating = True
End Sub
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
763
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Sir, Thank you for your code.
If you don't mind; ( You pointed out about no code in my workbook)
reason why I post here as a part of the first question, sorry about this
I had been searching but I do not find how to change the condition
and the display every time the sheet number change
I mean this lines:

► If cell = 51 Then '::::::::this is the number to change on every sheet.◄

and:
1623595519643.png

Please, thank you for your support and time
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,301
Office Version
  1. 2010
Platform
  1. Windows
My demonstration is an answer to the initial question according to Sheet4 to duplicate X times and changing the value in cell A1.​
Now I'm lost as it can't work with codename which does not exist in the attachment …​
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
763
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

I understand, and thanks for all the times you help me,
I really do not found how to upload the code in the attachment, I think thats why I didn't load up.

Have a nice sunday
My respect for you Sir.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,301
Office Version
  1. 2010
Platform
  1. Windows

Once Sheet4 is created and updated ?​
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
763
Office Version
  1. 2010
Platform
  1. Windows
Created and updated. Yes Sir.
If by that the meaning is, the code run on sheet four and perform everything for the first number on A1 then
create the next worksheet one number up, and the condition also will change to one number equal to A1
the only sheet number fix the sheet source number 3.
Thank you for asking.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,301
Office Version
  1. 2010
Platform
  1. Windows
So did you at least try my demonstration on your post #3 attachment ?​
 

Forum statistics

Threads
1,141,869
Messages
5,709,092
Members
421,615
Latest member
RAB29

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top