[已解决]不同文件夹里的同名文件合并

dc_empery

在A和B的文件夹里分别有多个相同名称的xls文件，把同名文件里的工作表合并起来后以原有名称保存到C文件里，已把例表上传至附件，现请求各位大师帮忙给予解决，在此先谢谢了！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-31 10:36

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim wb As Workbook, wb2 As Workbook
   
4. Dim zf$, i%, x%, mypath$, wj$
   
5. Application.ScreenUpdating = False
   
6. Application.DisplayAlerts = False
   
7. mypath = ThisWorkbook.Path & ""
   
8. wj = Dir(mypath & "A\*.xls")
   
9. Do While wj <> ""
   
10.     Set wb = GetObject(mypath & "A" & wj)
    
11.     zf = "新" & wj
    
12.     wb.SaveAs Filename:=mypath & "C" & zf
    
13.     Set wb2 = GetObject(mypath & "B" & wj)
    
14.     Application.Windows(zf).Visible = True
    
15.     Application.Windows(wb2.Name).Visible = True
    
16.     For i = 1 To wb2.Sheets.Count
    
17.         x = Workbooks(zf).Sheets.Count
    
18.         wb2.Sheets(i).Copy after:=Workbooks(zf).Sheets(x)
    
19.     Next
    
20.     wb2.Close 0
    
21.     Workbooks(zf).Close 1
    
22.     wj = Dir
    
23. Loop
    
24. Application.DisplayAlerts = True
    
25. Application.ScreenUpdating = True
    
26. End Sub
    

复制代码

跳转到最佳答案楼层

Banieliang

都是要编程的活，不简单啊

dsmch

无论是前台还是后台打开文件，两个重名文件（包括不在同一文件夹下）不能同时打开，这个是处理的难点。

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim wb As Workbook, wb2 As Workbook
   
4. Dim zf$, i%, x%, mypath$, wj$
   
5. Application.ScreenUpdating = False
   
6. Application.DisplayAlerts = False
   
7. mypath = ThisWorkbook.Path & ""
   
8. wj = Dir(mypath & "A\*.xls")
   
9. Do While wj <> ""
   
10.     Set wb = GetObject(mypath & "A" & wj)
    
11.     zf = "新" & wj
    
12.     wb.SaveAs Filename:=mypath & "C" & zf
    
13.     Set wb2 = GetObject(mypath & "B" & wj)
    
14.     Application.Windows(zf).Visible = True
    
15.     Application.Windows(wb2.Name).Visible = True
    
16.     For i = 1 To wb2.Sheets.Count
    
17.         x = Workbooks(zf).Sheets.Count
    
18.         wb2.Sheets(i).Copy after:=Workbooks(zf).Sheets(x)
    
19.     Next
    
20.     wb2.Close 0
    
21.     Workbooks(zf).Close 1
    
22.     wj = Dir
    
23. Loop
    
24. Application.DisplayAlerts = True
    
25. Application.ScreenUpdating = True
    
26. End Sub
    

复制代码

dsmch

………………

dc_empery

dsmch 发表于 2014-3-31 10:37
………………

真是太感谢dsmch大师给予精彩完美的解答，我的问题迎刃而解啦！