VBA宏可以根據源工作表單元格范圍更新工作表

Question

所以我想做的是根據源工作表（相同的工作簿）中的單元格范圍更新工作表列表。 我知道我可以通過刪除所有工作表並添加新工作表來做到這一點，但是我需要將它取出並添加另一個。

到目前為止，這就是我的問題，我的問題始於運行時或嘗試組合兩個宏以便將其鏈接到按鈕時什么都沒有響應的宏。

Sub Delete_Insert()

Dim i As Integer
i = 2
Dim ws As Worksheet

Dim stocks As Variant

Dim c_stocks As Integer
c_stocks = 7
Dim match As Boolean
'This is to see if a worksheet matched with a stock name
Dim j As Integer
j = 1
'To count the internal cell FOR loop

Application.DisplayAlerts = False
'This turns off the alert for deleting sheets

For Each ws In Worksheets

c = ActiveWorkbook.Worksheets.Count
    match = False
        For Each stocks In ThisWorkbook.Sheets("Main").Range("A2:A8").Cells
            If CStr(stocks) = ActiveWorkbook.Sheets(i).name Then
                match = True
                Exit For 
            End If
            Next stocks
    If match = False Then
            ws.Delete
    End If
    i = i + 1
    If i = c Then
            Exit For
    End If
    Next ws
End Sub`

然后這是要插入

For Each stocks In ThisWorkbook.Sheets("Main").Range("A2:A8").Cells
    i = 2
    match = False
        For Each ws In Worksheets
            If (ws.name = stocks) Then
                match = True
                Exit For

            End If

        i = i + 1


        Next ws

    If match = False Then

                ActiveWorkbook.Worksheets.Add
                ActiveSheet.Move After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
                ActiveSheet.name = CStr(stocks)
    End If

     j = j + 1

    If (j = 7) Then
        Exit For
    End If

    Next stocks


End Sub

Answer 1

像這樣（未經測試）：

Sub Delete_Insert()

    Dim i As Integer
    Dim sht As Worksheet, wb As Workbook
    Dim stocks As Range, c As Range, stck As String

    Set wb = ActiveWorkbook
    Set stocks = ThisWorkbook.Sheets("Main").Range("A2:A8")

    'remove sheets not in list
    For i = wb.Worksheets.Count To 1 Step -1
        Set sht = wb.Worksheets(i)
        If IsError(Application.match(sht.Name, stocks, 0)) Then
            Application.DisplayAlerts = False
            sht.Delete
            Application.DisplayAlerts = False
        End If
    Next i

    'add new sheets from list
    For Each c In stocks.Cells
        stck = c.Value
        If Len(stck) > 0 Then

            Set sht = Nothing
            On Error Resume Next
            Set sht = wb.Worksheets(stck)
            On Error GoTo 0

            If sht Is Nothing Then
                With wb.Worksheets.Add(after:=wb.Sheets(wb.Sheets.Count))
                    .Name = stck
                End With
            End If

        End If
    Next c

End Sub