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

montecarlo2012

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
985
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
1drv.ms

Book1.xlsx

Microsoft Excel Workbook
1drv.ms

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

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Hi !​
montecarlo2012 said:
On sheet 4 I have a format on column A
Click to expand...
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:
Upvote 0
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.
 
Upvote 0
montecarlo2012 said:
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
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
​
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 …​
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
​
So did you at least try my demonstration on your post #3 attachment ?​
 
Upvote 0
You must log in or register to reply here.

Similar threads

montecarlo2012
  • Solved
vba.- Adding Sheets.
2 3
Replies
24
Views
2K
montecarlo2012
montecarlo2012
montecarlo2012
  • Solved
/vba/ how to make it the worksheet index becoming a variable for looping [workbook-link]
Replies
4
Views
1K
Alex Blakenburg
A
montecarlo2012
  • Solved
vba- downsize my code
Replies
6
Views
587
montecarlo2012
montecarlo2012
H
  • Question Question
Excel Table Representation Query: 2 columns in the data set with dates which needs to be aligned to get right result.
Replies
1
Views
564
GraH
GraH

Forum statistics

Threads
1,223,711
Messages
6,174,025
Members
452,542
Latest member
Bricklin

Share this page

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
Back
Top