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

但是，我想使用特定模板創建工作表。 我想以模板方式填充數據。 我想以以下方式填充數據：

我想以模板方式填充數據。 關於如何修復我的代碼的任何線索？

Answer 1

將“get sheet”拆分成一個單獨的函數可以讓你的代碼更容易理解：

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