Excel VBA: Trying to refine code to Create Worksheets from a Template from a list of names

I

IGPOD

New Member
Joined
May 16, 2014
Messages
20
Hello,

I've copied some samples from multiple locations and trying to piece together a workable sample that I can use... I've gotten lost along the way and need some assistance.

What I'm trying to accomplish is having a Template I've created be copied with Values inserted from a table on another page. I had the code to create multiple Workbooks, but I would rather have Worksheets as it would be easier to manage and print all when I've completed the work.

You'll be able to see what I'm trying to do from the code, I've reached a personal impasse on this one and I know you'll be able to solve it; I appreciate your help in advance.

VBA Code: 
Sub create3()
Dim wsIndex As Worksheet, rngIndex As Range, rngData2 As Range, rngData3 As Range, wsData As Worksheet, wsData2 As Worksheet, wsData3 As Worksheet, rngData As Range, i%
Dim wbNew As Worksheet

    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in g26
    Set wsData = Sheets("Index")
    Set rngData = wsData.Range("d2") 'starting cell for what to paste in j85
    i = 0
    Set wsData2 = Sheets("index")
    Set rngData2 = wsIndex.Range("f2") 'starting cell for what to paste in j89
    i = 0
    Set wsData3 = Sheets("index")
    Set rngData3 = wsIndex.Range("g2") 'starting cell for what to paste in j93
    
    Do While Not Len(rngIndex.Offset(i, 0)) = 0 'starting at Q16, go down 1 row at a time until you hit an empty cell
    
        Sheets("Template").Copy
        Set wbNew = ActiveWorkbook
        wsData.Copy After:=wbNew.Sheets(1)
        
 With wbNew.thisworksheet
            .Range("g26") = rngIndex.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j85") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j89") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j93") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
        End With
        
        wbNew.SaveAs rngIndex.Offset(i, 0) & ".xlsx"
        wbNew.Close False
        
        i = i + 1
    
    Loop
    
    Set wsIndex = Nothing
    Set wsData = Nothing
    Set rngIndex = Nothing
    Set rngData = Nothing
    Set wbNew = Nothing

End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
try

VBA Code: 
Sub create3()
    Dim wbNew As Workbook
    
    Dim wsIndex As Worksheet
    
    Dim rngIndex As Range
    Dim rngData As Range
    
    Dim i As Integer

    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in g26
    Set rngData = wsIndex.Range("d2") 'starting cell for what to paste in j85
    
    i = 0
    Do While Not Len(rngIndex.Offset(i, 0)) = 0 'starting at Q16, go down 1 row at a time until you hit an empty cell
        Sheets("Template").Copy
        Set wbNew = ActiveWorkbook
        wsIndex.Copy After:=wbNew.Sheets(1)
        
        With wbNew.ActiveSheet
            .Range("g26") = rngIndex.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j85") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j89") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j93") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
        End With
        
        wbNew.SaveAs rngIndex.Offset(i, 0) & ".xlsx"
        wbNew.Close False
        
        i = i + 1
    Loop
    
    Set wbNew = Nothing
    
    Set wsIndex = Nothing
    
    Set rngIndex = Nothing
    Set rngData = Nothing
End Sub
 
Upvote 0
HongRu said:
try

VBA Code: 
Sub create3()
    Dim wbNew As Workbook
   
    Dim wsIndex As Worksheet
   
    Dim rngIndex As Range
    Dim rngData As Range
   
    Dim i As Integer

    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in g26
    Set rngData = wsIndex.Range("d2") 'starting cell for what to paste in j85
   
    i = 0
    Do While Not Len(rngIndex.Offset(i, 0)) = 0 'starting at Q16, go down 1 row at a time until you hit an empty cell
        Sheets("Template").Copy
        Set wbNew = ActiveWorkbook
        wsIndex.Copy After:=wbNew.Sheets(1)
       
        With wbNew.ActiveSheet
            .Range("g26") = rngIndex.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j85") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j89") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j93") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
        End With
       
        wbNew.SaveAs rngIndex.Offset(i, 0) & ".xlsx"
        wbNew.Close False
       
        i = i + 1
    Loop
   
    Set wbNew = Nothing
   
    Set wsIndex = Nothing
   
    Set rngIndex = Nothing
    Set rngData = Nothing
End Sub
Click to expand...
Thank you, this worked fantastically, however, instead of creating new workbooks per name -- how can I alter the code so that it will create named worksheets inside the active workbook instead. Everything I've tried doesn't work, thanks HongRu!
 
Upvote 0
Create named worksheets ?
In the code now, you have a new workbook with two worksheets named "Template" and "Index".
Is it not OK ?
What you need is to re-name the worksheets ?
Try this.

VBA Code: 
 wbNew.Sheets(1).Name = "ReName Template"
 wbNew.Sheets(2).Name = "ReName Index"

The code should be put behind this line:
VBA Code: 
wsIndex.Copy After:=wbNew.Sheets(1)
 
Upvote 0
HongRu said:
Create named worksheets ?
In the code now, you have a new workbook with two worksheets named "Template" and "Index".
Is it not OK ?
What you need is to re-name the worksheets ?
Try this.

VBA Code: 
 wbNew.Sheets(1).Name = "ReName Template"
 wbNew.Sheets(2).Name = "ReName Index"

The code should be put behind this line:
VBA Code: 
wsIndex.Copy After:=wbNew.Sheets(1)
Click to expand...
What I want to do is instead of creating new workbooks, I want worksheets created instead within the Active Workbook; renamed to the corresponding name from the range I've named "Names".

I tried the code you provided and although it worked it stopped after duplicating a new workbook with my template and index pages created. Thanks for your patience and help in this, I do appreciate it, it's just beyond my knowledge right now.
 
Upvote 0
try.

If you don't want a new workbook, then you will have a error on the two lines whick I make them to become comments.
About the sheets names, you should clarify which range they are in, and how they look like.....you better upload a sample by MiniSheet of XL2BB.

VBA Code: 
Sub create3()
    Dim wbNew As Workbook
    
    Dim wsIndex As Worksheet
    
    Dim rngIndex As Range
    Dim rngData As Range
    
    Dim i As Integer

    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in g26
    Set rngData = wsIndex.Range("d2") 'starting cell for what to paste in j85
    
    i = 0
    Do While Not Len(rngIndex.Offset(i, 0)) = 0 'starting at Q16, go down 1 row at a time until you hit an empty cell
        Sheets("Template").Copy before:=Sheets(1)
        Sheets(1).Name = "ReName Template" & i 'according to your Name range
        Set wbNew = ActiveWorkbook
        wsIndex.Copy After:=wbNew.Sheets(1)
        wbNew.Sheets(2).Name = "ReName Index" & i 'according to your Name range

        With wbNew.ActiveSheet
            .Range("g26") = rngIndex.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j85") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j89") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("j93") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
        End With
        
        'Here is a problem, so I make the two lines to be comments to prevent error
        'wbNew.SaveAs rngIndex.Offset(i, 0) & ".xlsx"
        'wbNew.Close False
        
        i = i + 1
    Loop
    
    Set wbNew = Nothing
    
    Set wsIndex = Nothing
    
    Set rngIndex = Nothing
    Set rngData = Nothing
End Sub
 
Upvote 0
So I was able to get the code working with the original sheet named "Index"... however, when I delete that sheet and import a new sheet named "Index", the code no longer works. It names all the sheets "Template(1)" "Template(2)" and so forth but also does not fill in the data from the code. Below is the code which works with my Master Workbook.

What do I need to do it get the VBA to recognize the newly imported "Index" page?

VBA Code: 
Sub TESTINGtestingTESTING()

    Dim wbNew As Workbook
    
    Dim wsIndex As Worksheet
    
    Dim rngIndex As Range
    Dim rngData As Range
    
    Dim i As Integer

    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in d11
    Set wsData = Sheets("Index")
    Set rngData = wsData.Range("e2") 'starting cell for what to paste in e39
    i = 0
        Set wsData2 = Sheets("Index")
    Set rngData2 = wsData2.Range("f2") 'starting cell for what to paste in e40
    i = 0
        Set wsData3 = Sheets("Index")
    Set rngData3 = wsData3.Range("g2") 'starting cell for what to paste in e41
    i = 0
    
    Do While Not Len(rngIndex.Offset(i, 0)) = 0 'starting at Q16, go down 1 row at a time until you hit an empty cell
        Sheets("Template").Copy before:=Sheets(1)
              
        Sheets(1).Name = rngIndex.Offset(i, 0) & i 'according to your Name range
        Set wbNew = ActiveWorkbook
        
        With wbNew.Sheets(1)
            .Range("d11") = rngIndex.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("e39") = rngData.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("e40") = rngData2.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
            .Range("e41") = rngData3.Offset(i, 0) 'starting at ??, you offset 1 additional row at each loop
        
        End With
        'Here is a problem, so I make the two lines to be comments to prevent error
        'wbNew.SaveAs rngIndex.Offset(i, 0) & ".xlsx"
        'wbNew.Close False
        
        i = i + 1
    Loop
    
    Set wbNew = Nothing
    
    Set wsIndex = Nothing
    
    Set rngIndex = Nothing
    Set rngData = Nothing
End Sub
 

Attachments

  • example2.png
    example2.png
    34.8 KB · Views: 6
Upvote 0
I have tried your code.
Basically, it works, and the VBA recognizes the newly imported "Index" sheet.
I did not find bugs about "Template(1)" which is not renamed according to the Name range.

But your code seems something strange.
This maybe should be replaced because to set the same workbook to the four different variables rngIndex, wsData, wsData1, wsData2 make no sense.
VBA Code: 
    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in d11
    Set wsData = Sheets("Index")
    Set rngData = wsData.Range("e2") 'starting cell for what to paste in e39
    i = 0
    Set wsData2 = Sheets("Index")
    Set rngData2 = wsData2.Range("f2") 'starting cell for what to paste in e40
    i = 0
        Set wsData3 = Sheets("Index")
    Set rngData3 = wsData3.Range("g2") 'starting cell for what to paste in e41
    i = 0
by
VBA Code: 
    Set wsIndex = Sheets("Index")

    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in d11    
    Set rngData = wsIndex.Range("e2") 'starting cell for what to paste in e39    
    Set rngData2 = wsIndex.Range("f2") 'starting cell for what to paste in e40   
    Set rngData3 = wsIndex.Range("g2") 'starting cell for what to paste in e41
    i = 0

If you want workbook to SaveAs a new file, maybe you should keep this
VBA Code: 
        Sheets("Template").Copy
not this
VBA Code: 
        Sheets("Template").Copy before:=Sheets(1)

I suggest you can press F8 to run the VBA code to debug line by line, and maybe you will find something interesting.
 
Upvote 0
Solution
HongRu said:
I have tried your code.
Basically, it works, and the VBA recognizes the newly imported "Index" sheet.
I did not find bugs about "Template(1)" which is not renamed according to the Name range.

But your code seems something strange.
This maybe should be replaced because to set the same workbook to the four different variables rngIndex, wsData, wsData1, wsData2 make no sense.
VBA Code: 
    Set wsIndex = Sheets("Index")
    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in d11
    Set wsData = Sheets("Index")
    Set rngData = wsData.Range("e2") 'starting cell for what to paste in e39
    i = 0
    Set wsData2 = Sheets("Index")
    Set rngData2 = wsData2.Range("f2") 'starting cell for what to paste in e40
    i = 0
        Set wsData3 = Sheets("Index")
    Set rngData3 = wsData3.Range("g2") 'starting cell for what to paste in e41
    i = 0
by
VBA Code: 
    Set wsIndex = Sheets("Index")

    Set rngIndex = wsIndex.Range("c2") 'starting cell for what to paste in d11   
    Set rngData = wsIndex.Range("e2") 'starting cell for what to paste in e39   
    Set rngData2 = wsIndex.Range("f2") 'starting cell for what to paste in e40  
    Set rngData3 = wsIndex.Range("g2") 'starting cell for what to paste in e41
    i = 0

If you want workbook to SaveAs a new file, maybe you should keep this
VBA Code: 
        Sheets("Template").Copy
not this
VBA Code: 
        Sheets("Template").Copy before:=Sheets(1)

I suggest you can press F8 to run the VBA code to debug line by line, and maybe you will find something interesting.
Click to expand...
Thank you HongRu!! Your help was amazing and the problem was solved!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Guna13
  • Question
How to Efficient way for create Multiple Workbooks
Replies
1
Views
159
Guna13
Guna13
V
  • Question
Excel VBA - How to modify my code to include a command that prints data to PDF
Replies
1
Views
150
VanGirl
V
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
392
Agnarr
Agnarr
E
  • Question
Excel VBA to Outlook Email Draft - How to save email draft copy to sharepoint / How to use template from sharepoint?
Replies
0
Views
333
elitef
E
H
  • Question
VBA Code to Copy a defined range from a defined list of Worksheets and paste into another sheet
Replies
3
Views
300
Georgiboy
Georgiboy

Forum statistics

Threads
1,215,633
Messages
6,125,922
Members
449,274
Latest member
mrcsbenson

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