Forum Discussion

anamarijaa's avatar
anamarijaa
Copper Contributor
Feb 20, 2024

Creating multiple worksheets with changed cell value

Hello,   I have a worksheet and I would like to have it copied 45 times. Is there a faster way than using move or copy function? Also what I would like to do is to change the value in the cell Q1 t...
excel
Macros and VBA
  • NikolinoDE's avatar
    NikolinoDE
    Feb 20, 2024

    anamarijaa 

    You can achieve this task efficiently using VBA (Visual Basic for Applications) in Excel. Below is a VBA code that will copy your worksheet 45 times and increment the value in cell Q1 for each new worksheet:

    Vba Code is untested, please backup your file.

    Sub CopyWorksheetsAndIncrement()
    Dim wsOriginal As Worksheet
    Dim wsNew As Worksheet
    Dim i As Integer
    
    ' Set reference to the original worksheet
    Set wsOriginal = ThisWorkbook.Sheets("OriginalSheetName") ' Change "OriginalSheetName" to the name of your original worksheet
    
    ' Copy the original worksheet 45 times and increment Q1 in each new worksheet
    For i = 1 To 45
        ' Copy the original worksheet
        wsOriginal.Copy After:=Sheets(Sheets.Count)
        
        ' Set reference to the newly copied worksheet
        Set wsNew = ActiveSheet
        
        ' Increment the value in cell Q1
        wsNew.Range("Q1").Value = i
        
        ' Rename the copied worksheet
        wsNew.Name = "NewSheet_" & i ' Change "NewSheet_" to the desired name prefix
        
        ' If your worksheet has formulas or other calculations that are based on Q1, you may need to update them here
        
    Next i
End Sub

    Before running the code:

    1. Replace "OriginalSheetName" with the name of your original worksheet.
    2. If you want a different name prefix for the new worksheets, change "NewSheet_" to your desired prefix.

    This code will copy your original worksheet 45 times, with the value in cell Q1 incremented for each new worksheet. It will also rename each copied worksheet with a unique name. Make sure to save your workbook before running the code, as it will create multiple new worksheets.Formularbeginn The text and steps were edited with the help of AI.

     

    My answers are voluntary and without guarantee!

     

    Hope this will help you.

    Was the answer useful? Mark as best response and Like it!

    This will help all forum participants.

anamarijaa's avatar
anamarijaa
Copper Contributor
Hi,
thank you. This was very helpful.
But I have one more question. How can I achieve that the names of the new worksheets would be same as the value in Q1?
NikolinoDE's avatar
NikolinoDE
Gold Contributor
Feb 21, 2024

anamarijaa 

You can modify the VBA code to set the name of each new worksheet based on the value in cell Q1. Here's the updated code:

Vba Code is untested please backup your file.

Sub CopyWorksheetsAndSetNames()
    Dim wsOriginal As Worksheet
    Dim wsNew As Worksheet
    Dim i As Integer
    Dim newName As String
    
    ' Set reference to the original worksheet
    Set wsOriginal = ThisWorkbook.Sheets("OriginalSheetName") ' Change "OriginalSheetName" to the name of your original worksheet
    
    ' Copy the original worksheet 45 times and set names based on value in Q1
    For i = 1 To 45
        ' Copy the original worksheet
        wsOriginal.Copy After:=Sheets(Sheets.Count)
        
        ' Set reference to the newly copied worksheet
        Set wsNew = ActiveSheet
        
        ' Set the new name based on the value in cell Q1
        newName = "NewSheet_" & wsNew.Range("Q1").Value ' Prefix "NewSheet_" can be customized
        
        ' Rename the copied worksheet
        wsNew.Name = newName
        
        ' If your worksheet has formulas or other calculations that are based on Q1, you may need to update them here
    Next i
End Sub

With this code, each newly copied worksheet will be named based on the value in cell Q1 of that worksheet. Ensure that the value in cell Q1 is unique for each worksheet, as worksheet names must be unique within a workbook.