Sub 合併工作簿中的工作表到當前活頁簿()
    Dim wbDest As Workbook
    Dim wsDest As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim strPath As String
    Dim strFile As String
    Dim replaceAll As Boolean
    Dim wsName As String
    
    ' 設置目標活頁簿為當前活頁簿
    Set wbDest = ThisWorkbook
    ' 指定資料夾路徑
    strPath = "C:\\您的資料夾路徑\\"
    
    ' 確保路徑以反斜線結尾
    If Right(strPath, 1) <> "\\" Then strPath = strPath & "\\"
    
    ' 獲取資料夾中的第一個Excel檔案
    strFile = Dir(strPath & "*.xls*")
    
    ' 循環處理找到的所有檔案
    Do While strFile <> ""
        ' 打開源工作簿
        Set wbSource = Workbooks.Open(Filename:=strPath & strFile)
        
        ' 循環每個工作表
        For Each wsSource In wbSource.Sheets
            wsName = wsSource.Name
            ' 檢查工作表名稱是否存在
            On Error Resume Next
            Set wsDest = wbDest.Sheets(wsName)
            On Error GoTo 0
            
            If Not wsDest Is Nothing Then
                If replaceAll = False Then
                    If MsgBox("工作表名稱 '" & wsName & "' 已存在。是否要替換它? " & _
                              "選擇 '是' 替換所有重複的工作表，選擇 '否' 僅替換這個。", _
                              vbYesNoCancel + vbQuestion, "替換工作表") = vbYes Then
                        replaceAll = True
                    ElseIf vbCancel Then
                        Exit Sub
                    End If
                End If
                
                If replaceAll = True Then
                    Application.DisplayAlerts = False
                    wsDest.Delete
                    Application.DisplayAlerts = True
                End If
            End If
            
            ' 複製工作表到目標活頁簿
            wsSource.Copy After:=wbDest.Sheets(wbDest.Sheets.Count)
            wbDest.Sheets(wbDest.Sheets.Count).Name = wsName
            
            ' 重置 wsDest 以供下一次檢查
            Set wsDest = Nothing
        Next wsSource
        
        ' 關閉源工作簿
        wbSource.Close SaveChanges:=False
        
        ' 獲取下一個檔案名稱
        strFile = Dir
    Loop
    
    MsgBox "所有工作表已經合併到當前活頁簿。", vbInformation
End Sub