Question

我有以下代码来创建模板的副本，根据另一工作表的每一行中的数据填充该模板，并根据该行中的员工对其进行重命名。但是，我继续得到名为Template（2）的工作表。

Option Explicit
Sub NewSheets()
    Dim i As Integer
    Dim ws As Worksheet
    Dim sh As Worksheet
    Set ws = Sheets("Template")
    Set sh = Sheets("Employee_Data")
    Application.ScreenUpdating = True

    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = sh.Range("B" & i).Value
        ActiveSheet.Range("C1").Value = sh.Range("A" & i).Value
        ActiveSheet.Range("C2").Value = sh.Range("G" & i).Value
        ActiveSheet.Range("C3").Value = sh.Range("H" & i).Value
        ActiveSheet.Range("C4").Value = sh.Range("I" & i).Value
        ActiveSheet.Range("C5").Value = sh.Range("J" & i).Value
        ActiveSheet.Range("C6").Value = sh.Range("S" & i).Value
        ActiveSheet.Range("C7").Value = sh.Range("V" & i).Value
        ActiveSheet.Range("C8").Value = sh.Range("W" & i).Value
        ActiveSheet.Range("C9").Value = sh.Range("X" & i).Value
        ActiveSheet.Range("C11").Value = sh.Range("L" & i).Value
        ActiveSheet.Range("C12").Value = sh.Range("AH" & i).Value
        ActiveSheet.Range("C13").Value = sh.Range("AJ" & i).Value
        ActiveSheet.Range("C14").Value = sh.Range("AM" & i).Value
        ActiveSheet.Range("C15").Value = sh.Range("AP" & i).Value
        ActiveSheet.Range("C16").Value = sh.Range("AQ" & i).Value
        ActiveSheet.Range("H1").Value = sh.Range("F" & i).Value
        ActiveSheet.Range("H3").Value = sh.Range("K" & i).Value
        ActiveSheet.Range("N1").Value = sh.Range("C" & i).Value
        ActiveSheet.Range("N11").Value = sh.Range("N" & i).Value
    Next i
End Sub

我确实找到了可以创建模板的多个副本并根据需要对其进行重命名的代码，但是我无法弄清楚如何编写用特定员工的每一行数据填充模板所需的代码。该代码如下：

Sub CreateSheetsFromAList()
' Example Add Worksheets with Unique Names
    Dim MyRange As Range
    Dim dic As Object, c As Range
    Dim k As Variant, tmp As String

    Set dic = CreateObject("scripting.dictionary")
    Set MyRange = Sheets("Employee_Data").Range("B2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    Sheets("Template").Visible = True

    For Each c In MyRange
        tmp = Trim(c.Value)
        If Len(tmp) > 0 Then dic(tmp) = dic(tmp) + 1
    Next c

    For Each k In dic.keys
        If Not WorksheetExists(k) Then
          Sheets("Template").Copy After:=Sheets(Sheets.Count)
          ActiveSheet.Name = k    ' renames the new worksheet
        End If
    Next k

    Sheets("Template").Visible = False
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
  WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function

我知道我总是可以删除额外的工作表，但是如果我没有做的那么好，因为当前项目有13个不同的组，这将需要完成。任何帮助将不胜感激。

Answer 1

最好更加明确，减少/消除对ActiveSheet的依赖：

Option Explicit

Sub NewSheets()
    Dim i As Integer
    Dim ws As Worksheet, wb As Workbook
    Dim sh As Worksheet, wsCopy as worksheet, v

    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Template")
    Set sh = wb.Sheets("Employee_Data")

    For i = 2 To sh.Range("B" & sh.Rows.Count).End(xlUp).Row

        ws.Copy After:=wb.Sheets(wb.Sheets.Count)
        Set wsCopy = wb.Sheets(wb.Sheets.Count) '<<<< get a reference to the copy

        wsCopy.Name = sh.Range("B" & i).Value
        wsCopy.Range("C1").Value = sh.Range("A" & i).Value

        'EDIT: only copy value if not empty
        v = sh.Range("AJ" & i).Value
        If Len(v) > 0 Then wsCopy.Range("C13").Value = v

        '...
        'snipped for clarity
        '...
        wsCopy.Range("N11").Value = sh.Range("N" & i).Value

    Next i
End Sub

如何复制一个模板，用另一个工作表中的数据填充它，并在不创建Template（2）的情况下从另一个工作表中的范围重命名它？

1 个答案: