loop through sheet arrays

[ajm]

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]

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]

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:

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]

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.

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++.