根據現有列表創建和更新工作表

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