loop through sheet arrays

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
1,735
i am having trouble working with sheet arrays. i have a relatively simple task of producing a particular report which gives our customers a snapshot of their stats for a week and then saving the file twice - once as is, and secondly with no links/formulas/etc (basically paste as values for everything). from the hard coded copy, i then need to create a workbook for each customer which contains a copy of their sheet and a copy of the data sheet. so, two sheets in each customer workbook.

as an example, my master workbook contains seven worksheets: Data, Shop 1, Shop 2, Outlet 1, Outlet 2, Place 1, and Place 2. I need create 6 new workbooks. the first will contain sheets Data and Shop 1; the second will contain Data and Shop 2; the third, Data and Outlet 1; the fourth, Data and Outlet 2; the fifth, Data and Place 1, and finally, the sixth workbook will contain a copy of Data and Place 2. Each new workbook would be saved in the same folder as the original using a name from a cell on the Data tab.

i can do the hard coding bit of the macro and i know how to create a new workbook for each of the customers using sheet(array("xxx","yyy")).copy. where i am struggling is putting it altogether so that at runtime, the macro will save the original workbook as values only, and then create the new workbooks for each of my customers, saving them using the customer's name from their sheet

any pointers would be a great help
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,166
Do you have any starter code so far? If yes, can you post it and then ask a specific question on what part you have a problem with.
 

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
1,735
so far have only set up the save as values, and each sheet array. so, at present, my macro copies each sheet as values, and then creates the new workbook for each array. end result, i end up with 20 new workbooks which i then have to manually name and save. the workbook is on my work pc but macro, adapted from a piece of code i found on vbaexpress effectively looks like this:

Code:
Option Explicit

Sub CreateCustomerFiles()
   
    Dim Data, Shop 1, Shop 2, Outlet 1, Outlet 2, Place 1, Place 2 As Sheets
    Dim nm As Name
    Dim ws As Worksheet

    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
              "New sheets will be pasted as values, named ranges removed" _
     , vbYesNo, "NewCopy") = vbNo Then Exit Sub

        With Application
            .ScreenUpdating = False


            '       Paste sheets as values
            '       Remove External Links, Hperlinks and hard-code formulas
            '       Make sure A1 is selected on all sheets
            For Each ws In ActiveWorkbook.Worksheets
                ws.Cells.Copy
                ws.[A1].PasteSpecial Paste:=xlValues
                ws.Cells.Hyperlinks.Delete
                Application.CutCopyMode = False
                Cells(1, 1).Select
                ws.Activate
            Next ws
            Cells(1, 1).Select

            '       Remove named ranges
            For Each nm In ActiveWorkbook.Names
                nm.Delete
            Next nm

with thisworkbook
          Sheets(Array("Data", "Shop 1")).copy
          Sheets(Array("Data", "Shop 2")).copy
          Sheets(Array("Data", "Outlet 1")).copy
          Shop1 = Sheets(Array("Data", "Outlet 2")).copy
          Shop1 = Sheets(Array("Data", "Place 1")).copy
          Shop1 = Sheets(Array("Data", "Place 2")).copy
end with
            
            '       Save it with the NewName and in the same directory as original
            'ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
          '  ActiveWorkbook.Close SaveChanges:=False

            .ScreenUpdating = True
        End With
        Exit Sub
its something like this anyway. i may have some of the syntax wrong.
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,362
Office Version
365
Platform
Windows
If you want to save the newly created workbooks create a reference to ActiveWorkbook after you've copied the worksheets.

I'd also suggest that you create a reference to the original workbook the code is in.

If you are working like multiple workbooks then that will make sure you are referencing the correct objects, eg worksheets.

If you don't do that there's a chance you might end up copying/saving things incorrectly.

Something like this.
Code:
Option Explicit
Sub CreateCustomerFiles()
 Dim wbThis As Workbook
 Dim wbNew As Workbook
 Dim nm As Name
 Dim ws As Worksheet
 Dim strPath As String
   
  Set wbThis = ThisWorkbook
  
  strPath = wbThis.Path
  
  If MsgBox("Copy specific sheets to a new workbook" & vbCr & "New sheets will be pasted as values, named ranges removed", vbYesNo, "NewCopy") = vbNo Then 
   Exit Sub
  End if
  With Application
   .ScreenUpdating = False

   '       Paste sheets as values
   '       Remove External Links, Hperlinks and hard-code formulas
   '       Make sure A1 is selected on all sheets
   For Each ws In wbThis.Worksheets
    ws.Cells.Copy
    ws.[A1].PasteSpecial Paste:=xlValues
    ws.Cells.Hyperlinks.Delete
    .CutCopyMode = False
    .Goto ws.Cells(1, 1)
   Next ws          
   '       Remove named ranges
   For Each nm In wbThis.Names
    nm.Delete
   Next nm
    
   arrShops = Array("Shop 1", "Shop 2", "Outlet 1", "Outlet 2", "Place 1", "Place 2")
   With wbThis
    For I = LBound(arrShops) To UBound(arrShops)
     
     .Worksheets("Data").Copy
     Set wbNew = ActiveWorkbook
     .Worksheets(arrShops(I)).Copy After:=wbNew.Worksheets(1)
     
     wbNew.SaveAs wbThis.Path & "\" & arrShops(I)
     
     wbNew.Close
    Next I
   End With
   
  End With  
     
 End Sub
PS If the code you posted was dodgy syntax wise, I'd hate to think what this is - I wrote it in NotePad++.:)
 

Forum statistics

Threads
1,081,617
Messages
5,360,049
Members
400,565
Latest member
Tommy O

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top