Макросы Excel для заполнения данных из мастер-листа в несколько шаблонов

Question

У меня есть лист Excel, который имеет лист со структурой, приведенной ниже:

Я хочу создать отдельный лист для каждого 'Название модели ». Мой код ниже делает это правильно.

    Option Explicit
Sub Splitdatatosheets()
'
' Splitdatatosheets Macro
'
'
Dim rng As Range
Dim rng1 As Range
Dim vrb As Boolean
Dim sht As Worksheet
Set rng = Sheets("Sheet1").Range("A4")
Set rng1 = Sheets("Sheet1").Range("A4:BD4")
vrb = False
Do While rng <> ""
    For Each sht In Worksheets
           If sht.Name = Left(rng.Value, 31) Then
                sht.Select
                Range("A2").Select
           Do While Selection <> ""
                 ActiveCell.Offset(1, 0).Activate
           Loop 
            rng1.Copy ActiveCell 
            ActiveCell.Offset(1, 0).Activate 
            Set rng1 = rng1.Offset(1, 0) 
            Set rng = rng.Offset(1, 0) 
            vrb = True 
        End If
    Next sht 
    If vrb = False Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Left(rng.Value, 31)
    Sheets("Sheet1").Range("A3:BD3").Copy ActiveSheet.Range("A1")
    Range("A2").Select               
    Do While Selection <> ""               
        ActiveCell.Offset(1, 0).Activate                    
    Loop
    rng1.Copy ActiveCell
    Set rng1 = rng1.Offset(1, 0)    
    Set rng = rng.Offset(1, 0)    
    End If    
vrb = False
Loop
End Sub

Однако я хочу создать листы с указанным c шаблоном. Я хочу заполнить данные шаблонным способом. Я хочу заполнить данные следующим образом:

Я хочу заполнить данные шаблонным способом. Любая подсказка о том, как мой код может быть исправлен?

Answer 1

Разделение «получить лист» на отдельную функцию упрощает выполнение кода:

Sub Splitdatatosheets()

    Dim c As Range, wsModel As Worksheet, wsData As Worksheet

    Set wsData = ThisWorkbook.Sheets("Sheet1")

    For Each c In wsData.Range(wsData.Range("A4"), _
                               wsData.Cells(Rows.Count, 1).End(xlUp)).Cells

        Set wsModel = ModelSheet(c.Value) 'get the model sheet
        With wsModel
            .Range("B6").Value = c.Offset(0, 1).Value 'for example
            'etc etc populate the other data
        End With

    Next c
End Sub

'get a worksheet by name - create if not found
Function ModelSheet(modelName As String) As Worksheet
    Dim ws As Worksheet, model
    model = Left(modelName, 31)
    With ThisWorkbook
        On Error Resume Next
        Set ws = .Worksheets(model)
        On Error GoTo 0
        If ws Is Nothing Then
            'no matching sheet, so create it by copying a template sheet
            .Sheets("Template").Copy after:=.Sheets(.Sheets.Count)
            Set ws = .Sheets(.Sheets.Count)
            ws.Name = model
        End If
    End With
    Set ModelSheet = ws
End Function