VBA help in a macro to create sheets in a new book

nisanthp

New Member
Joined
Jul 1, 2009
Messages
26
Hi,

I have a running macro (lets call this Macro 1) which will create multiple sheets based on a template and range in a different sheet. This is working fine within the source file. I usually run Macro 1 and save the file and then move the new sheets to another file and break the links using another macro (Macro 2).

I'm trying to find a way to combine both macros, create new sheets based on the range, move new sheets to new file and break the links.

This is Macro 1

Sub CreateAndNameWorksheets()
Dim c As Range

Application.ScreenUpdating = False
For Each c In Sheets("Codes").Range("A2:A" & Sheets("Codes").Range("A" & Rows.Count).End(xlUp).Row)
Sheets("Template").Range("A1") = c
Sheets("Template").Copy After:=Sheets(Sheets.Count)
With c
ActiveSheet.Name = .Value
End With
Next c
Application.ScreenUpdating = True
End Sub



Macro 2

Sub copySheet()
Dim folderPath As String

folderPath = Application.ActiveWorkbook.Path
Dim Actsheet As String

Application.ScreenUpdating = False
On Error Resume Next
ActiveWindow.SelectedSheets.Copy
ActNm = ActiveSheet.Name
Sheets(ActiveSheet.Name).Visible = True

Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If


Application.ScreenUpdating = True
Application.GetSaveAsFilename
End Sub

Thanks in advance.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
I am wondering if the copy process can not be made a lot more efficient.
If I understand correctly, then for each cell in column A of sheet Codes, you copy that cell value into A1 of Template.
Next you make a copy of template giving it the name of the copied cell value.

Then you manually move the copied sheet to another file. Which file? A new file where they are all put together/ Or each to a different file?

Then lastly you break any links using macro 2.

Presumably then the Template has formulas which use the cell A1.

Do these formulas still need to work once the sheet is copied, or could the sheet formulas be turned into values?
 
Upvote 0
I am wondering if the copy process can not be made a lot more efficient.
If I understand correctly, then for each cell in column A of sheet Codes, you copy that cell value into A1 of Template.
Next you make a copy of template giving it the name of the copied cell value.

Then you manually move the copied sheet to another file. Which file? A new file where they are all put together/ Or each to a different file?

Then lastly you break any links using macro 2.

Presumably then the Template has formulas which use the cell A1.

Do these formulas still need to work once the sheet is copied, or could the sheet formulas be turned into values?
Hi,

Your understanding is correct, I'll explain this more :

the purpose of this template is to create Specification sheets as attached sample from a Master data base. "Codes" sheet has Item unique codes, SAN 1, SAN 2 etc (in this case) and with the relevant data of each item and this is populated into template. Total number of items can run to 50's or 60's. So 1st macro helps in 1 click creation of this sheet.

With the 1st macro new sheets are created in the same master file. I have to share this data to our clients, either in PDF or in excel as required. For this purpose I use 2nd macro to move the new "spec sheets" and value paste it, to new file and the master file is kept intact. The final shared file will be free of links and can easily create single PDF of same sections.

When you say this process can be made more efficient, is it by modifying the macro or by something else?
 

Attachments

  • Sanitary_1.jpg
    Sanitary_1.jpg
    75.1 KB · Views: 5
Upvote 0
What I will do is change the macro, so it makes a copy of the template sheet with the unique code. Then copy / paste values over itself. That removes all the formulas and so also any links. Then the sheet is immediately moved to a new file.

By using an array for the 'copy/paste' it will be very fast.
 
Upvote 0
Oh, I dont know abt that, infact I'm a newbie to macro itself, I modified the above ones referring from various souces.

Can you help with Array function.
 
Upvote 0
Here is the code with ample comments for you to understand what is happening. See the comment starting with <<<< for your input.

If you want to understand arrays better and why they are so much faster, then read the Short guide to better VBA, the link is below in my tag line.

VBA Code:
Option Explicit

Sub CreateOutputSheets()
    Dim wbOut As Workbook
    Dim wsTempl As Worksheet, wsCopy As Worksheet, wsCodes As Worksheet
    Dim vIn As Variant, vCodes As Variant
    Dim lR As Long, lC As Long, UB1 As Long, UB2 As Long
    Dim rIn As Range
    Dim sSlash As String, sOutputPath As String
    
    'set variables to the various sheets and workbooks. helps confusion
    Set wsTempl = ThisWorkbook.Sheets("Template")
    Set wsCodes = ThisWorkbook.Sheets("Codes")
    'create the output workbook
    Set wbOut = Workbooks.Add
    
    'get the path where it is to be saved
    sOutputPath = ThisWorkbook.Path     '<<<< The files will be stored in the same directory as this workbook. _
                                                If you want them somewhere else, replace Thisworkbook.path with the _
                                                correct path inbetween "". Like "C:\\Mydocs\Output"
    'check path
    sSlash = IIf(sOutputPath Like "*\*", "\", "/")
    sOutputPath = sOutputPath & sSlash
    
    ' Set rIn to the range in Template to be copied
    Set rIn = wsTempl.UsedRange
    UB1 = rIn.Rows.Count
    UB2 = rIn.Columns.Count
    
    'put the column A of Codes into an array
    With wsCodes
        vCodes = .Range("A2:A" & .UsedRange.Rows.Count).Value
    End With
    
    ' minimise the screenflikker (also speeds things up)
    Application.ScreenUpdating = False
    
    'Now loop through each of the entries
    For lR = 1 To UBound(vCodes, 1)
        ' copy it to Template A1
        rIn(1, 1) = vCodes(lR, 1)
        'allow time for the calculations
        wsTempl.Calculate
        'make a copy of the sheet and rename the copy
        wsTempl.Copy
        Set wsCopy = ActiveSheet
        wsCopy.Name = vCodes(lR, 1)
        'now copy the Value (not the formulas) from the template into an array
        vIn = rIn.Value
        'and overwrite the Copied sheet with the values from the array
        wsCopy.Range("A1").Resize(UB1, UB2).Value = vIn
        ' lastly move the sheet to the new workbook
        wsCopy.Move after:=wbOut.Sheets(wbOut.Sheets.Count)
        
    Next lR
    'remove initial sheets from the output workbook
    lC = wbOut.Sheets.Count - (lR - 1)
    Application.DisplayAlerts = False
    For lR = lC To 1 Step -1
        wbOut.Sheets(lR).Delete
    Next lR
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    'save the new workbook with date stamp
    wbOut.SaveAs sOutputPath & "Output_" & Format(Now, "yyyy_mm_dd_hh.mm")
    
    
    'cleanup
    Set wsTempl = Nothing
    Set wsCodes = Nothing
    Set wsCopy = Nothing
    Set wbOut = Nothing
End Sub
 
Upvote 0
Solution
Here is the code with ample comments for you to understand what is happening. See the comment starting with <<<< for your input.

If you want to understand arrays better and why they are so much faster, then read the Short guide to better VBA, the link is below in my tag line.

VBA Code:
Option Explicit

Sub CreateOutputSheets()
    Dim wbOut As Workbook
    Dim wsTempl As Worksheet, wsCopy As Worksheet, wsCodes As Worksheet
    Dim vIn As Variant, vCodes As Variant
    Dim lR As Long, lC As Long, UB1 As Long, UB2 As Long
    Dim rIn As Range
    Dim sSlash As String, sOutputPath As String
   
    'set variables to the various sheets and workbooks. helps confusion
    Set wsTempl = ThisWorkbook.Sheets("Template")
    Set wsCodes = ThisWorkbook.Sheets("Codes")
    'create the output workbook
    Set wbOut = Workbooks.Add
   
    'get the path where it is to be saved
    sOutputPath = ThisWorkbook.Path     '<<<< The files will be stored in the same directory as this workbook. _
                                                If you want them somewhere else, replace Thisworkbook.path with the _
                                                correct path inbetween "". Like "C:\\Mydocs\Output"
    'check path
    sSlash = IIf(sOutputPath Like "*\*", "\", "/")
    sOutputPath = sOutputPath & sSlash
   
    ' Set rIn to the range in Template to be copied
    Set rIn = wsTempl.UsedRange
    UB1 = rIn.Rows.Count
    UB2 = rIn.Columns.Count
   
    'put the column A of Codes into an array
    With wsCodes
        vCodes = .Range("A2:A" & .UsedRange.Rows.Count).Value
    End With
   
    ' minimise the screenflikker (also speeds things up)
    Application.ScreenUpdating = False
   
    'Now loop through each of the entries
    For lR = 1 To UBound(vCodes, 1)
        ' copy it to Template A1
        rIn(1, 1) = vCodes(lR, 1)
        'allow time for the calculations
        wsTempl.Calculate
        'make a copy of the sheet and rename the copy
        wsTempl.Copy
        Set wsCopy = ActiveSheet
        wsCopy.Name = vCodes(lR, 1)
        'now copy the Value (not the formulas) from the template into an array
        vIn = rIn.Value
        'and overwrite the Copied sheet with the values from the array
        wsCopy.Range("A1").Resize(UB1, UB2).Value = vIn
        ' lastly move the sheet to the new workbook
        wsCopy.Move after:=wbOut.Sheets(wbOut.Sheets.Count)
       
    Next lR
    'remove initial sheets from the output workbook
    lC = wbOut.Sheets.Count - (lR - 1)
    Application.DisplayAlerts = False
    For lR = lC To 1 Step -1
        wbOut.Sheets(lR).Delete
    Next lR
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    'save the new workbook with date stamp
    wbOut.SaveAs sOutputPath & "Output_" & Format(Now, "yyyy_mm_dd_hh.mm")
   
   
    'cleanup
    Set wsTempl = Nothing
    Set wsCodes = Nothing
    Set wsCopy = Nothing
    Set wbOut = Nothing
End Sub
Hi Thanks a lot for the help, this code is working as intended and no complaints in that.

Just mentioning couple of errors noted :

After creating all the sheets the code is showing an error,
when I click debug it is showing at this code "wsCopy.Name = vCodes(lR, 1)"
I think bcos of this, a new file is created with a copy of template sheet.

Also the file save code is not working no default file is saved in the location nor this is asking to save the file which is not an issue.

In the final file, the first sheet created when starting "sheet1" is there along with the newly created sheets, I tried adding macro to delete that but not working. I tried

Sheets("Sheet1").Delete and

ThisWorkbook.Sheets("Sheet1").Activate
ActiveSheet.Delete

Both didnt work.

I wrote this code bfore "save file" code, as this is to be done after creating all the sheets and before saving the workbook.
 
Upvote 0
Strange, because when I test this it works without any problems, including deleting the initial sheet(s).
Where you say the error is,vis where the copied sheet gets its name. Now a reason for this failing could be that there is a character in the name that is not allowed for a sheet name, such as -+* and more. What do thes codes in column A look like?
I think that also messes up deleting the initial sheets
 
Upvote 0
Can you send me the file? If you send me a Dropbox link or so through a private message
 
Upvote 0
Strange, because when I test this it works without any problems, including deleting the initial sheet(s).
Where you say the error is,vis where the copied sheet gets its name. Now a reason for this failing could be that there is a character in the name that is not allowed for a sheet name, such as -+* and more. What do thes codes in column A look like?
I think that also messes up deleting the initial sheets
Its working now, I tried deleting the sheet after the last cell and ran the macro once again, then it worked without above issues and saved the file too after deleting the initial sheet. I think the issue was some characters as you mentioned

Thanks for helping,. I guess the file is not required now,
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

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