Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1902|回复: 4

[已解决]求助:合并工作簿代码

[复制链接]
发表于 2012-11-20 10:03 | 显示全部楼层 |阅读模式
同一文件夹里有18个工作簿,每个工作簿只有一个工作表,工作表的列数相同,每个工作表第一行是标题行。怎样用一段代码将全部工作簿合并到同一工作表中。
最佳答案
2012-11-20 10:16
Sub 合并()
Dim i As Integer
Dim path As String, pathxx As String
Dim Filename As String
Application.ScreenUpdating = False
twna = ThisWorkbook.Name
pathxx = ThisWorkbook.path
path = ThisWorkbook.path & "\*.xls"
   Filename = Dir(path)
Do
   If Filename <> ThisWorkbook.Name Then
      i = i + 1
      Range("Ad" & i) = Filename
   End If
      Filename = Dir
Loop Until Filename = ""

For i = 1 To [ad65536].End(3).Row
bgmc = Range("ad" & i)
Workbooks.Open Filename:=pathxx & "\" & bgmc
Sheets(1).Select
Range("a2:ab" & [b65536].End(3).Row).Copy
Windows(twna).Activate
Range("a" & [b65536].End(3).Row + 1).Select
ActiveSheet.Paste
Windows(bgmc).Activate
Application.CutCopyMode = False
ActiveWindow.Close
Next
[ad:ad].ClearContents
Application.ScreenUpdating = True
[a1].Select
End Sub
发表于 2012-11-20 10:16 | 显示全部楼层    本楼为最佳答案   
Sub 合并()
Dim i As Integer
Dim path As String, pathxx As String
Dim Filename As String
Application.ScreenUpdating = False
twna = ThisWorkbook.Name
pathxx = ThisWorkbook.path
path = ThisWorkbook.path & "\*.xls"
   Filename = Dir(path)
Do
   If Filename <> ThisWorkbook.Name Then
      i = i + 1
      Range("Ad" & i) = Filename
   End If
      Filename = Dir
Loop Until Filename = ""

For i = 1 To [ad65536].End(3).Row
bgmc = Range("ad" & i)
Workbooks.Open Filename:=pathxx & "\" & bgmc
Sheets(1).Select
Range("a2:ab" & [b65536].End(3).Row).Copy
Windows(twna).Activate
Range("a" & [b65536].End(3).Row + 1).Select
ActiveSheet.Paste
Windows(bgmc).Activate
Application.CutCopyMode = False
ActiveWindow.Close
Next
[ad:ad].ClearContents
Application.ScreenUpdating = True
[a1].Select
End Sub
回复

使用道具 举报

 楼主| 发表于 2012-11-20 11:10 | 显示全部楼层
zyouong 发表于 2012-11-20 10:16
Sub 合并()
Dim i As Integer
Dim path As String, pathxx As String

列数不够,我的表格有50列。                                 
回复

使用道具 举报

发表于 2012-11-20 11:21 | 显示全部楼层
Range("a2:ab" & [b65536].End(3).Row).Copy改Range("a2:BB" & [b65536].End(3).Row).Copy
回复

使用道具 举报

 楼主| 发表于 2012-12-12 13:18 | 显示全部楼层
zyouong 发表于 2012-11-20 11:21
Range("a2:ab" & .End(3).Row).Copy改Range("a2:BB" & .End(3).Row).Copy

谢谢!                                                
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 19:07 , Processed in 0.303794 second(s), 7 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表