Sub UpdateAllWorksheets_依地區分割()

    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim wsMain As Worksheet
    Dim wsTemp As Worksheet
    Dim Dict As Object
    Dim c As Range
    Dim LastRow As Long
    Dim shName As String

    '指定主工作表
    Set wsMain = ThisWorkbook.Sheets("總表") '修改此處為您的主工作表名稱
    Set Dict = CreateObject("Scripting.Dictionary")

    LastRow = wsMain.Cells(wsMain.Rows.Count, "F").End(xlUp).Row
    
    ' 建立字典，鍵為工作表名，值為相應的 Range 對象
    For Each c In wsMain.Range("F2:F" & LastRow)
        shName = c.Value
        If Not Dict.Exists(shName) Then
            Dict.Add shName, c
        Else
            Set Dict(shName) = Union(Dict(shName), c)
        End If
    Next c
    
' 刪除不再存在於主工作表中的工作表
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> wsMain.Name And ws.Name <> "工作按鈕" Then
        If Not Dict.Exists(ws.Name) Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    End If
Next ws

    
    ' 更新或創建工作表
    For Each Key In Dict.Keys
        On Error Resume Next
        Set wsTemp = ThisWorkbook.Sheets(Key)
        On Error GoTo 0
        If wsTemp Is Nothing Then
            Set wsTemp = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            wsTemp.Name = Key
            wsMain.Rows(1).Copy Destination:=wsTemp.Rows(1)
        Else
            wsTemp.Cells.ClearContents
            wsMain.Rows(1).Copy Destination:=wsTemp.Rows(1)
        End If
        Dict(Key).EntireRow.Copy wsTemp.Cells(wsTemp.Cells(wsTemp.Rows.Count, "A").End(xlUp).Row + 1, 1)
        Set wsTemp = Nothing
    Next Key
    
       ' 設定所有工作表的列高與欄寬
    For Each ws In ThisWorkbook.Sheets
        ws.Cells.EntireColumn.AutoFit
        ws.Cells.EntireRow.AutoFit
    Next ws
    

    Application.ScreenUpdating = True

End Sub