Merge two macros together to make them work with each other

[BusinessHack]

Hi,

I need to merge to Macros to work with each other.

The first Macro grabs names in a cell range then makes new tab names with the names in those cells -

Sub Invoices_Add_Named_Tabs()
    Dim MyCell As Range, MyRange As Range
    
    Set MyRange = Sheets("Address").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
 
    For Each MyCell In MyRange
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
    Next MyCell
End Sub

The other macro copies a sheet and all its data into a new sheet -

Sub Invoices_Add_Invoice()
    Dim x As Integer
   
    x = InputBox("Enter number of times to copy Sheet1")
    For numtimes = 1 To x
        'Loop by using x as the index number to make x number copies.
        'Replace "Sheet1" with the name of the sheet to be copied.
        ActiveWorkbook.Sheets("Invoice").Copy _
           After:=ActiveWorkbook.Sheets("Address")
    Next
End Sub

I need the macro to make a new sheet and named according to the names in the cell range, and copy into each of the new tab the data from sheet "Invoice".

So for example if there is 8 cells to be made into 8 named tabs, then each of the 8 newly made tabs will have the same data from the sheet "Invoice"

If there are 16 cells to be made into 16 named tabs, then each of the 16 newly made tabs will have the same data from the sheet "Invoice"

Each month the number range will change, so the macro will need to know how much is in the range, so it knows how many times to copy the data in the "Invoice" sheet.

I tried the following code but it did not work properly -

Sub Invoices_Add_Named_Tabs()
 Dim MyCell As Range, MyRange As Range
 Dim x As Integer
 
 Set MyRange = Sheets("Address").Range("A2")
 Set MyRange = Range(MyRange, MyRange.End(xlDown))
 
 For Each MyCell In MyRange
 Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
 Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
 Next MyCell
 
 x = InputBox("Enter number of times to copy Sheet1")
 For numtimes = 1 To x
 'Loop by using x as the index number to make x number copies.
 'Replace "Sheet1" with the name of the sheet to be copied.
 ActiveWorkbook.Sheets("Invoice").Copy _
 After:=ActiveWorkbook.Sheets("Address")
 Next
 
 End Sub

It was first adding the new tabs and name them as in the cells, but will then ask to "Enter number of time to copy Sheet1" then it will add the that number of sheets between the main sheet (Address) and the newly name tabs.

The copied sheet has the correct data in it, but the tabs are named incorrectly (Sheet (2), Sheet (3) etc) then the new tabs which are named correctly have no data in it the sheets.


Thank You in advance

 

[AlphaFrog]

Change this one line to copy the Invoice sheet for each name instead of adding a blank sheet.

[COLOR=darkblue]Sub[/COLOR] Invoices_Add_Named_Tabs()
    [COLOR=darkblue]Dim[/COLOR] MyCell [COLOR=darkblue]As[/COLOR] Range, MyRange [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] MyRange = Sheets("Address").Range("A2")
    [COLOR=darkblue]Set[/COLOR] MyRange = Range(MyRange, MyRange.End(xlDown))
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] MyCell [COLOR=darkblue]In[/COLOR] MyRange
[B]        ActiveWorkbook.Sheets("Invoice").Copy _[/B]
[B]           After:=Sheets(Sheets.Count) [COLOR=green]'Copy Invoice worksheet[/COLOR][/B]
        Sheets(Sheets.Count).Name = MyCell.Value [COLOR=green]' renames the new worksheet[/COLOR]
    [COLOR=darkblue]Next[/COLOR] MyCell
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[BusinessHack]

Thanks a lot AlphaFrog, worked perfectly, much appreciated.

 

[AlphaFrog]

You're welcome. Thanks for the feedback.