[已解决]excel檔合併和拆出

sweet520t

請問大師有多個Excel檔合併成一個excel的程式嗎？
和一個excel裡面有多個工作表，拆出多個excel檔？

謝謝大師

最佳答案

月排行榜 / 总排行榜

爱疯

2016-6-8 23:55

• 按某列拆分为多个工作簿或工作表或文本
  

• 合并工作簿或工作表
  

可以试下

跳转到最佳答案楼层

爱疯

• 按某列拆分为多个工作簿或工作表或文本
  

• 合并工作簿或工作表
  

可以试下

乐乐2006201506

早就收藏了，看着效果很好，只是自己还不习惯这种合并，慢慢适应就好了。

文刀天可

1. Sub 合并指定工作簿()
   
2.     Dim FilesToOpen
   
3.     Dim x As Integer
   
4. 
   
5.     On Error GoTo ErrHandler
   
6.     Application.ScreenUpdating = False
   
7. 
   
8.     FilesToOpen = Application.GetOpenFilename(FileFilter:="MicroSoft Excel文件(*.xls),*.xls", MultiSelect:=True, Title:="要合并的文件")
   
9. 
   
10.     If TypeName(FilesToOpen) = "Boolean" Then
    
11.         MsgBox "没有选中文件"
    
12.         GoTo ExitHandler
    
13.     End If
    
14. 
    
15.     x = 1
    
16.     While x <= UBound(FilesToOpen)
    
17.         Workbooks.Open Filename:=FilesToOpen(x)
    
18.         Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    
19.         x = x + 1
    
20.     Wend
    
21. ExitHandler:
    
22.     Application.ScreenUpdating = True
    
23.     Exit Sub
    
24. ErrHandler:
    
25.     MsgBox Err.Description
    
26.     Resume ExitHandler
    
27. End Sub

复制代码

文刀天可

1. '合并一个工作薄中的工作表
   
2. Sub 合并工作表()
   
3. Dim sht As Worksheet, xrow As Integer, rng As Range
   
4. For Each sht In Worksheets
   
5. If sht.Name <> ActiveSheet.Name Then
   
6. Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1)
   
7. xrow = sht.Range("a1").CurrentRegion.Rows.Count - 1
   
8. sht.Range("a2").Resize(xrow, 100).Copy rng
   
9. End If
   
10. sht.Rows(1).Copy Range("A1")
    
11. Next
    
12. End Sub

复制代码

sweet520t

乐乐2006201506 发表于 2016-6-9 08:16
早就收藏了，看着效果很好，只是自己还不习惯这种合并，慢慢适应就好了。

請問可以給我嗎？

sweet520t

文刀天可 发表于 2016-6-9 11:29

好像不能執行，請問有拆分工作表的嗎

sweet520t

爱疯 发表于 2016-6-8 23:55

按某列拆分为多个工作簿或工作表或文本

合并工作簿或工作表

我想要的拆分工作表，好像不是這種的，我要的是一個excel裡面很多工作表，拆成個別一個