excel - 根据现有列表创建和更新工作表

Question

我正在尝试自定义一个 VBA 代码，该代码将根据预先存在的列表创建新工作表。由于需要更多数据，我会不断更新此列表。我正在使用的 VBA 代码(下方)能够创建新工作表，但我需要能够更新它(创建新工作表)，同时忽略已经创建的工作表。有什么建议吗？

Sub CreateSheetsFromList()
Dim ws As Worksheet, Ct As Long, c As Range
Set ws1 = Worksheets("Template")
Set ws2 = Worksheets("Job List")
Application.ScreenUpdating = False
For Each c In Sheets("Job List").Range("A4:A51")
   If c.Value <> "" Then
       ws1.Copy after:=Sheets(Sheets.Count)
       ActiveSheet.Name = c.Value
       Ct = Ct + 1
   End If
Next c
If Ct > 0 Then
   MsgBox Ct & " new sheets created from list"
Else
   MsgBox "No names on list"
End If
Application.ScreenUpdating = True
End Sub

Answer 1

从列表创建工作表

Option Explicit

Sub CreateSheetsFromList()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws1 As Worksheet: Set ws1 = wb.Worksheets("Template")
    Dim ws2 As Worksheet: Set ws2 = wb.Worksheets("Job List")
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim c As Range
    Dim Ct As Long
    For Each c In ws2.Range("A4:A51").Cells
       If Len(c.Value) > 1 Then
           On Error Resume Next
           Set ws = wb.Worksheets(c.Value)
           On Error GoTo 0
           If ws Is Nothing Then
               ws1.Copy After:=wb.Sheets(wb.Sheets.Count)
               ActiveSheet.Name = c.Value
               Ct = Ct + 1
           Else
               ' worksheet already exists
               Set ws = Nothing
           End If
       End If
    Next c
    
    Application.ScreenUpdating = True
    
    If Ct > 0 Then
       MsgBox Ct & " new sheets created from list"
    Else
       MsgBox "No non-existing worksheet names on list"
    End If

End Sub