VBAmacros可以更新基于源工作表单元格区域的工作表

所以我想要做的是根据我的源工作表(相同的工作簿)中的单元格范围更新工作表的列表。 我知道我可以通过删除所有的工作表并添加新的工作表来做到这一点,但我需要把它拿出来,并添加另一个工作表。

这是我到目前为止,我的问题开始macros运行时没有响应或当我试图结合这两个macros,以便我可以链接到一个button,没有任何反应。

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 

像这样(未经testing):

 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