Блог

У меня есть таблица с клиентами, которая имеет формат ниже и отформатирована как ListObject — Customer. На основе приведенной ниже таблицы следует создать новые листы в соответствии с количеством клиентов на вкладке «Клиенты».

На основе приведенной выше таблицы следует создать 3 листа под названием — Customer1, Customer2 и Customer3. Эти новые листы являются копией шаблона, который выглядит следующим образом:

• синие ячейки — это заголовки, которые являются частью листа шаблона
• серые ячейки пусты, и данные с главного листа должны быть скопированы в соответствии с названием листа. Я добавил ссылки на ячейки (они всегда будут одинаковыми)

Идеальный результат должен выглядеть так для всех листов:

Мне удалось создать макрос, который создает листы и называет их соответствующим образом, но я не могу управлять передачей данных из всей строки в отдельные ячейки.

 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 " amp; Nm.Text)
    Next Nm
    
   Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub
 

Можете ли вы посоветовать мне, как копировать и переносить данные соответствующим образом и динамически, пожалуйста?

Большое спасибо!

Назовите все серые поля в шаблоне в соответствии с их значениями в таблице. Замените интервалы между словами символом подчеркивания (например, Customer_ID). При присвоении имен ячейкам обязательно выбирайте шаблон, а не саму книгу.

Затем вы можете использовать следующий код:

 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
 

Код перемещается по всем строкам объекта listobject (сначала для каждого)

Создает новый лист для каждой строки и называет его в соответствии с первой ячейкой.

Затем записывает значения в каждое серое поле, сопоставляя имя поля с именами столбцов списка. (по второму для каждого)

Соответствующее значение из таблицы клиентов можно найти, пересекая диапазон столбцов списка со строкой из первого для каждого цикла.