基于表行创建新的Excel文件，同时将表值的相应行复制到新文件中

Question

希望根据行/表的信息填充“模板”工作表，并保存为单独的工作表。

工作表"DataSource“布局为A-AB列(row1中的标题)

目标是对于每个" IB#“(列B)，根据"IB#”行的信息填充一个模板，并为每个IB#生成一个新的Excel文件。

-更新！！

我做到了。如何优化第2部分(填写模板)？

Sub AAA_Refresh_Temp()
'1) I was generating a new sheet per IB

    Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
    Set sh1 = Sheets("Template")
    Set sh2 = Sheets("CommStat")
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        sh1.copy After:=Sheets(Sheets.Count)
        ActiveSheet.name = c.Value
        ActiveSheet.Range("A9") = "'" & ActiveSheet.name
'(A9 is where I filled the IB number so that every time A9 is different,
' it populates the rest of the chart/template)

'2) Filling The Template
'-------I am trying to optimize the following part:-------

        Call AAA_Fill_Temp
        With Sheets("CommStat")
            Sheets("CommStat").Range("B2", .Range("B2").End(xlDown)).name = "IB_Accounts"
            Sheets("CommStat").Range("C2", .Range("C2").End(xlDown)).name = "IB_Information"
            Sheets("CommStat").Range("AA2", .Range("AA2").End(xlDown)).name = "IB_Adress1"
            Sheets("CommStat").Range("AB2", .Range("AB2").End(xlDown)).name = "IB_Adress2"
            Sheets("CommStat").Range("D2", .Range("D2").End(xlDown)).name = "ColD"
            Sheets("CommStat").Range("E2", .Range("E2").End(xlDown)).name = "ColE"
            Sheets("CommStat").Range("F2", .Range("F2").End(xlDown)).name = "ColF"
            Sheets("CommStat").Range("G2", .Range("G2").End(xlDown)).name = "ColG"
            Sheets("CommStat").Range("H2", .Range("H2").End(xlDown)).name = "ColH"
            Sheets("CommStat").Range("I2", .Range("I2").End(xlDown)).name = "ColI"
            Sheets("CommStat").Range("J2", .Range("J2").End(xlDown)).name = "ColJ"
            Sheets("CommStat").Range("K2", .Range("K2").End(xlDown)).name = "ColK"
            'Sheets("CommStat").Range("K2", .Range("K2").End(xlDown)).name = "ColL"
            Sheets("CommStat").Range("M2", .Range("M2").End(xlDown)).name = "ColM"
            Sheets("CommStat").Range("N2", .Range("N2").End(xlDown)).name = "ColN"
            Sheets("CommStat").Range("O2", .Range("O2").End(xlDown)).name = "ColO"
            Sheets("CommStat").Range("P2", .Range("P2").End(xlDown)).name = "ColP"
            Sheets("CommStat").Range("Q2", .Range("Q2").End(xlDown)).name = "ColQ"
            Sheets("CommStat").Range("R2", .Range("R2").End(xlDown)).name = "ColR"
            Sheets("CommStat").Range("S2", .Range("S2").End(xlDown)).name = "ColS"
            Sheets("CommStat").Range("T2", .Range("T2").End(xlDown)).name = "ColT"
            'Sheets("CommStat").Range("U2", .Range("U2").End(xlDown)).name = "ColU"
            'Sheets("CommStat").Range("V2", .Range("V2").End(xlDown)).name = "ColV"
            'Sheets("CommStat").Range("W2", .Range("W2").End(xlDown)).name = "ColW"
            'Sheets("CommStat").Range("X2", .Range("X2").End(xlDown)).name = "ColX"
            'Sheets("CommStat").Range("Y2", .Range("Y2").End(xlDown)).name = "ColY"
            'Sheets("CommStat").Range("Z2", .Range("Z2").End(xlDown)).name = "ColZ"
        End With
    Next
End Sub

Sub AAA_Fill_Temp()
    Dim bottom As String
    bottom = Range("A9").End(xlDown).Address
    bottom = Replace(bottom, "$A$", "")
    'Sheets("Test").Range("E4:E" & bottom).Formula = "=IFERROR(LOWER(INDEX(IB_Information, MATCH(C4, IB_Accounts,0),2)), ""Missing"")"
    'Sheets("Test").Range("F4:F" & bottom).Formula = "=IFERROR(PROPER((INDEX(IB_Information,MATCH(C4,IB_Accounts,0),1))), ""Missing"")"
'    >> Fills The Name and Address1&2
    ActiveSheet.Range("A11:A11").Formula = "=IFERROR(PROPER(INDEX(IB_Information, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
    ActiveSheet.Range("A12:A12").Formula = "=IFERROR(UPPER(INDEX(IB_Adress, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
    ActiveSheet.Range("A13:A13").Formula = "=IFERROR(UPPER(INDEX(IB_Adress2, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
'    >> Fills The Columns D-K
    ActiveSheet.Range("B22:B22").Formula = "=IFERROR((INDEX(ColD, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B23:B23").Formula = "=IFERROR((INDEX(ColE, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B24:B24").Formula = "=IFERROR((INDEX(ColF, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B25:B25").Formula = "=IFERROR((INDEX(ColG, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B26:B26").Formula = "=IFERROR((INDEX(ColH, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B27:B27").Formula = "=IFERROR((INDEX(ColI, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B28:B28").Formula = "=IFERROR((INDEX(ColJ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B29:B29").Formula = "=IFERROR((INDEX(ColK, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
'    .Range("B22:B22").Formula = "=IFERROR((INDEX(ColL, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

'    >> Fills The Columns M-Z
    ActiveSheet.Range("C22:C22").Formula = "=IFERROR((INDEX(ColM, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C23:C23").Formula = "=IFERROR((INDEX(ColN, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C24:C24").Formula = "=IFERROR((INDEX(ColO, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C25:C25").Formula = "=IFERROR((INDEX(ColP, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C26:C26").Formula = "=IFERROR((INDEX(ColQ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C27:C27").Formula = "=IFERROR((INDEX(ColR, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C28:C28").Formula = "=IFERROR((INDEX(ColS, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C29:C29").Formula = "=IFERROR((INDEX(ColT, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Answer 1

备注：

1. 这是一个未经测试的解决方案
2. 如果您提供一些示例数据/工作簿，
3. 会更容易在尝试它之前备份您的数据
4. AAA_Fill_Temp虽然代码更多，但它遵循一些良好的做法，并尝试组织您的代码中正在发生的事情<代码>H211<代码>G212

让我知道结果。

代码

Option Explicit

Public Sub GenerateSheets()

    Dim templateSheet As Worksheet
    Dim commStatSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceRange As Range
    Dim cell As Range

    Dim lastRow As Long

    Set templateSheet = ThisWorkbook.Worksheets("Template")
    Set commStatSheet = ThisWorkbook.Worksheets("CommStat")

    lastRow = commStatSheet.Cells(commStatSheet.Rows.Count, "B").End(xlUp).Row

    Set sourceRange = commStatSheet.Range("B2:B" & lastRow)

    For Each cell In sourceRange.Cells

        Set targetSheet = DuplicateSheet(templateSheet.Name, cell.Value)

        targetSheet.Name = cell.Value
        targetSheet.Range("A9").Value = "'" & targetSheet.Name

    Next cell

End Sub

Private Sub prepareCommStatSheet(ByVal commStatSheet As Worksheet)

    Dim columnList As String
    Dim columnArray As Variant

    Dim startRow As Long
    Dim lastRow As Long
    Dim counter As Long

    startRow = 2
    columnList = "B,C,AA,AB,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T"

    columnArray = Split(columnList, ",")

    ' Assign name to columns whose name doesn't correspond to the column letter

    assignNameToRange commStatSheet, "B", "IB_Accounts", startRow
    assignNameToRange commStatSheet, "C", "IB_Information", startRow
    assignNameToRange commStatSheet, "AA", "IB_Adress1", startRow
    assignNameToRange commStatSheet, "AB", "IB_Adress2", startRow

    For counter = 0 To UBound(columnArray)

        With commStatSheet

            assignNameToRange commStatSheet, columnArray(counter), "col" & columnArray(counter), startRow

        End With

    Next counter

End Sub

Private Sub assignNameToRange(ByVal targetSheet As Worksheet, ByVal targetColumn As String, ByVal targetName As String, ByVal startRow As Long)

    Dim lastRow As Long

    lastRow = targetSheet.Cells(targetSheet.Rows.Count, targetColumn).End(xlUp).Row
    targetSheet.Range(targetColumn & startRow & ":" & targetColumn & lastRow).Name = targetName

End Sub

Private Sub fillTargetSheet(ByVal targetSheet As Worksheet)

    With targetSheet
'    >> Fills The Name and Address1&2
        .Range("A11:A11").Formula = "=IFERROR(PROPER(INDEX(IB_Information, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
        .Range("A12:A12").Formula = "=IFERROR(UPPER(INDEX(IB_Adress, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
        .Range("A13:A13").Formula = "=IFERROR(UPPER(INDEX(IB_Adress2, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
'    >> Fills The Columns D-K
        .Range("B22:B22").Formula = "=IFERROR((INDEX(ColD, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B23:B23").Formula = "=IFERROR((INDEX(ColE, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B24:B24").Formula = "=IFERROR((INDEX(ColF, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B25:B25").Formula = "=IFERROR((INDEX(ColG, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B26:B26").Formula = "=IFERROR((INDEX(ColH, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B27:B27").Formula = "=IFERROR((INDEX(ColI, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B28:B28").Formula = "=IFERROR((INDEX(ColJ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B29:B29").Formula = "=IFERROR((INDEX(ColK, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
'    .Range("B22:B22").Formula = "=IFERROR((INDEX(ColL, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

'    >> Fills The Columns M-Z
        .Range("C22:C22").Formula = "=IFERROR((INDEX(ColM, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C23:C23").Formula = "=IFERROR((INDEX(ColN, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C24:C24").Formula = "=IFERROR((INDEX(ColO, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C25:C25").Formula = "=IFERROR((INDEX(ColP, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C26:C26").Formula = "=IFERROR((INDEX(ColQ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C27:C27").Formula = "=IFERROR((INDEX(ColR, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C28:C28").Formula = "=IFERROR((INDEX(ColS, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C29:C29").Formula = "=IFERROR((INDEX(ColT, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    End With

End Sub


Public Function DuplicateSheet(ByVal sheetSourceName As String, ByVal sheetTargetName As String) As Worksheet

    ' Credits: https://stackoverflow.com/a/58661151/1521579

    Dim newSheet As Worksheet
    Dim position As Long

    position = GetFirstVisiblePostion

    ThisWorkbook.Worksheets(sheetSourceName).Copy Before:=ThisWorkbook.Sheets(position)

    Set newSheet = ThisWorkbook.Sheets(position)

    newSheet.Name = sheetTargetName

    Set DuplicateSheet = newSheet

End Function

Private Function GetFirstVisiblePostion() As Long
    ' Credits: https://stackoverflow.com/a/58661151/1521579
    Dim wbSheet As Worksheet
    Dim position As Long
    For Each wbSheet In ThisWorkbook.Sheets
        If wbSheet.Visible = xlSheetVisible Then
            position = wbSheet.Index
            Exit For
        End If
    Next
    GetFirstVisiblePostion = position
End Function