如何将不同工作簿中的所有SHEET，合并到一个工作簿中，sheet名依然不变，

shenzl163

比如第一个工作簿有50个sheet 第二个工作簿有30个sheet 合并到一个新的工作簿中，形成 80个sheet ，每个sheet的原来名称不变

abc123281

1. Sub 汇总abc123()
   
2. Dim arr()
   
3. Dim wb As Workbook
   
4. Dim mypath$, myname$
   
5. Application.DisplayAlerts = False
   
6. Application.ScreenUpdating = False
   
7. mypath = ThisWorkbook.Path & ""
   
8. myname = Dir(mypath & "*.xl*")
   
9. Do While myname <> ""
   
10.   If myname <> ThisWorkbook.Name Then
    
11.      n = 0
    
12.      Set wb = Workbooks.Open(mypath & myname)
    
13.      With wb
    
14.        For Each ws In .Worksheets
    
15.           n = n + 1
    
16.           ReDim Preserve arr(1 To n)
    
17.           arr(UBound(arr)) = ws.Name
    
18.        Next
    
19.       .Worksheets(arr).Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    
20.       .Close False
    
21.      End With
    
22.      End If
    
23.   myname = Dir()
    
24. Loop
    
25. Worksheets("汇总工作表").Activate
    
26. Application.DisplayAlerts = True
    
27. Application.ScreenUpdating = True
    
28. MsgBox "汇总完成！", vbInformation, "信息提示"
    
29. End Sub

复制代码

abc123281

汇总工作表123.rar (47.75 KB, 下载次数: 84)

2018-10-17 22:11 上传

点击文件名下载附件