如何从许多200个左右excel文件中提取其中某几列汇总到一个新
运行excel后按住alt依次按f11,i,m
粘贴下面代码后做必要修改后按f5 即可在当前工作表中得到汇总结果.
Sub test()
c = Array(1, 3, 5, 7, 8)
p = ＂d：\汇总文件所在目录\＂ '根据实际修改 注意别遗漏最后的\
f = Dir(p & ＂*.xlsx＂)
Set ns = ActiveSheet
Do Until f = ＂＂
Set wb = Workbooks.Open(p & f)
For i = 0 To 4
n = n + 1
ns.Cells(2, n).Resize(144).Value = wb.Sheets(＂1号房间＂).Cells(2, c).Resize(144).Value
Next
wb.Close False
f = Dir
Loop
End Sub
提取多个相同格式excel表中的数据
楼主，我认为您这个事可行，出家人不敢打妄语， 我不出家人也不敢打妄语！
如果您也不想放弃这个机会的话，我愿一试，请HI我留言。
回答者： lxlzmh2002 - 大魔法师 八级 2009-8-19 04:40
=========================================================================
楼主，今天帮人写了一个多表合并的VBA程序，忽然想起好象看过有类似要的贴子，所以就找到您这个贴子，再来回答一次：
VBA代码如下：
Dim sht As Worksheet
Dim rs As Long, js As Long, ds As Long
Dim i As Integer
On Error Resume Next
Set sht = Sheets（＂汇总＂）
If Err.Number = 0 Then
Sheets（＂汇总＂）.Select
ActiveSheet.Range(＂A1＂).CurrentRegion.ClearContents
Else
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = ＂汇总＂
End If
Sheets(2).Range(＂1:1＂).Copy Sheets（＂汇总＂）.Range(＂A1＂)
For i = 2 To Sheets.Count
ds = Sheets（＂汇总＂）.Range(＂A65536＂).End(xlUp).Row + 1
rs = Sheets(i).Range(＂A65536＂).End(xlUp).Row
js = Sheets(i).Range(＂A1＂).End(xlToRight).Column
With Sheets(i)
.Select
.Range(Cells(2, 1), Cells(rs, js)).Copy Sheets（＂汇总＂）.Cells(ds, 1)
End With
Next
Sheets（＂汇总＂）.Select
上述代码使用方法如下：
录制宏：菜单＂工具＂->宏->录制宏）--> ＂宏名＂处给宏取名字->设定快捷键，＂快捷键＂下面输入一个字母-->确定后开始录制宏。
编辑宏：开始录制后即可直接按停止键， 然后编辑宏（工具->宏->宏（M）->选择刚建那个宏->点右边的＂编辑＂按钮-->进入宏编辑界面-->删除Sub XXX 至 End Sub之间所有内容-->然后粘贴上述程序代码-->按工具栏上的＂保存＂按钮-->＂文件＂菜单-->关闭并反回MicorSoft Excel
执行宏： 按刚刚设定的快捷键（Ctrl+那个字母）， 或者通过菜单＂工具＂-->宏-->宏（M）-->窗口上选宏名， 按＂执行＂按钮执行宏.
===================================================================
这段VBA代码功能说明：
1.执行VBA代码之后，程序会自己增加一个名为＂汇总＂的工作表.
2.将sheet1（叫不叫sheet1无索味，程序自会知道名字）的第一行作为＂汇总＂表的第一行。
3.然后依次将除＂汇总＂表以外的工作表内， 从第二行开始的所有行所有列以追加方式添加到＂汇总＂表内（通常认为第一行是标题）
4.追加过程，相当于复制粘贴，但要比手工复制粘贴快得多，可以说是瞬间完成。且是您用快捷键执行一次，所有工作表全部汇总一次。
行与不行，您一试便知。关于这个代码的使用方面有问题，请Hi我~~~~~
