同目录多表格合并一张新EXECL

 

Sub cfl()
Dim fs, f, f1, fc, s, x, rowss, columnss
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("D:\") '这里指定你多文档的目录
Set fc = f.Files
x = 1

For Each f1 In fc

If Right(f1.Name, 3) = "xls" Then '这里修改多文档的格式
Workbooks.Open (f1.Path)
rowss = Workbooks(f1.Name).Sheets(1).Range("A65536").End(xlUp).Row
columnss = Workbooks(f1.Name).Sheets(1).Columns.Count

Workbooks(f1.Name).Sheets(1).Range("A1:z" & CStr(rowss)).Copy
Workbooks(1).Activate
Workbooks(1).Sheets(1).Range("A" & CStr(x) & ":z" & CStr(x + rowss)).Select
Workbooks(1).Sheets(1).Paste
Application.CutCopyMode = False

x = x + rowss
Workbooks(f1.Name).Close savechanges:=False
End If

Next

End Sub

本列以OFFICE2003为准,如果是2007版,请将第10行If Right(f1.Name, 3) = "xls" Then语句中的xls修改成xlsx,这里也主要是看你多文档的格式是什么

1.新建一个EXECL文档,菜单里选择:工具-宏-Visual Basic编辑器,右键sheet1查看代码,复制粘贴上面的代码,保存.

2.关闭Visual Basic编辑器,菜单里选择:工具-宏-宏.在弹出的窗体中,位置:所有打开的工作簿-执行.