I have a table with customers, which has the below format and is formatted as ListObject - Customer. Based on the below table, new sheets should be created as per number of customers in the Customer tab.

Based on the above table, 3 sheets should be created called - Customer1, Customer2 and Customer3. These new sheets are copy of a template, which looks like this:

• blue cells are headers, which are part of the template sheet
• grey cells are blank and data from the Master sheet should be copied over as per the sheet name. I added the references of cells (it will be always the same)

The ideal output should look like this for all sheets:

I was able to create a macro, which creates sheets and named them accordingly, but I'm not able to manage transfer data from the whole row into particular cells.

Option Explicit

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet
Dim shNAMES As Range, Nm As Range

With ThisWorkbook
    Set wsTEMP = .Sheets("Template")                                'sheet to be copied
    Set wsMASTER = .Sheets("Customers")              'sheet with names
    Set shNAMES = wsMASTER.Range("Customers[Customer ID]")  'range to find names to be checked
    
    Application.ScreenUpdating = False
    For Each Nm In shNAMES
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)
            ActiveSheet.Name = CStr("Customer " & Nm.Text)
    Next Nm
    
   Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub

Can you advise me, how to copy and transpose data accordingly and dynamically, please?

Many thanks!

CodePudding user response：

Name all grey fields in the template according to their pendants in the table. Replace word spacings with an underscore (e.g. Customer_ID). Be sure to select the template not the workbook itself when naming the cells.

Then you can use the following code:

Sub SheetsFromTemplate()

Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wsCustomer As Worksheet
Dim loMaster As ListObject

With ThisWorkbook
    Set wsTEMP = .Sheets("Template")                                'sheet to be copied
    Set wsMASTER = .Sheets("Customers")              'sheet with names
    
    Set loMaster = wsMASTER.ListObjects("Customer")
    
    Dim r As Range, Customer As String
    Dim lc As ListColumn
    
    Application.ScreenUpdating = False
    
    For Each r In loMaster.DataBodyRange.Rows
        Customer = r.Cells(1, 1)
        wsTEMP.Copy After:=.Sheets(.Sheets.Count)
        Set wsCustomer = ActiveSheet
        
        With wsCustomer
            .Name = Customer
            
            For Each lc In loMaster.ListColumns
                'Assumption: per each list column there is a named range on the sheet
                'empty spaces in column names are replaced by an underscore in range name
                .Range(Replace(lc.Name, " ", "_")) = Intersect(lc.DataBodyRange, r)
            Next
        End With
    Next
   Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub

The code moves through all rows of the listobject (first for-each)

Creates the new sheet per row and names it according go the first cell.

Then writes the values to each grey field by mapping the field-name to the list column names. (second for-each)

The relevant value from the customer-table is found by intersecting the listcolumn-range with the row from the first for-each-loop.