【EXCEL_VBA_实战】多工作薄合并深入理解

工作背景：多个工作薄存在冲突的名称，需快速合并

困难点：工作表移动复制时，若有冲突的名称，会不断弹出对话框待人工确认

思路：利用代码确认弹出的对话框

关键代码：Application.DisplayAlerts = False

Sub Merge_WB()
'文件合并Dim WBs_Source As Variant '工作薄序列
Dim s As Integer '工作薄序列下标'选择工作薄（）
WBs_Source = Application.GetOpenFilename(fileFilter:="xlsx文件(*.xls*),*.xls*", Title:="选择Excel文件", MultiSelect:=True)
If TypeName(WBs_Source) = "Boolean" Then Exit SubDim WB_Source As Workbook
Dim WS_Source As Worksheet' 打开工作簿
For s = 1 To UBound(WBs_Source)'设定当前打开工作簿名称为WB_Source Workbooks.Open WBs_Source(s), UpdateLinks:=0 '不更新外部链接Set WB_Source = GetObject(WBs_Source(s))'逐一复制粘贴工作表'重要代码，避免工作表复制过程中名称冲突'下行代码可以默认确认EXCEL弹出的对话框（不用手动逐个点击）Application.DisplayAlerts = FalseFor Each WS_Source In WB_Source.SheetsWS_Source.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)NextApplication.DisplayAlerts = Ture'关闭源工作簿WB_Source.Close SaveChanges:=False'删除当前工作薄的无效名称AvoidingNameInvalid WB_Source:=ThisWorkbookNextEnd SubFunction AvoidingNameInvalid(WB_Source As Workbook)
'删除当前工作薄的无效名称Dim nmSource As Name'删除当前打开工作薄的无效名称For Each nmSource In WB_Source.NamesIf InStr(1, nmSource.RefersTo, "#REF!") > 0 ThenOn Error Resume Next ' 忽略错误，以防删除时出现问题Debug.Print nmSource.Name & ": deleted" '在立即窗口查看即将删除的名称nmSource.DeleteOn Error GoTo 0 ' 恢复正常的错误处理End IfNext nmSourceEnd Function