怎么将多个工作薄里面的表合并在一个工作薄里面？

我的e盘的一个文件夹里面有很多个工作薄，每个工作薄里面都有一个工作表
我现在想把众多个工作薄里边的表合并在一个工作薄里面，且合并之后工作表的名称和格式都保持不变，如果手动的移动复制工作表的话，那太慢了
请问各位高手有没有什么批处理的办法可以实现！
谢谢！

我的意思是把很多张工作薄里面的那张工作表，移动到一个新的工作薄里面
比如：我有150个工作薄，每个工作薄里面都有一张工作表
现在我要把每个工作薄里面的那张表移动到一个新的工作薄里面
那么这个新的工作薄里面就有那移动过来的150张工作表
要求是，移动过来的表的名称、表里面的内容及格式都保持不变，如果原来的表名是“150”那么移动过来的表名也叫“150”
请高手指教.....批处理方法

"1605333"帮我写的宏，是把每张表里面的内容复制到一张表里面了，可能是我没描述清楚，请再指点一下，万分感谢！

MyPath = ActiveWorkbook.Path
ActiveName = ActiveWorkbook.Name
MyName = Dir(MyPath & "\" & "*.xls")
i = 0
Do While MyName <> ""
If MyName <> ActiveName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
i = i + 1
With Workbooks(1).ActiveSheet
For j = 1 To Sheets.Count
Wb.Sheets(j).Copy Before:=Workbooks(ActiveName).Sheets(1)
Next
Wbn = Wbn & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
MsgBox "共合并了" & i & "个工作薄,如下:" & Chr(13) & Wbn, , "工作簿合并"

试试以上代码，
PS:如果超出了工作簿能容纳的工作表数量，会出错哦。

用EXCEL的宏功能就可以了，
新建一个宏，输入如下代码。
功能：合并同一根目录下所有工作簿的第一张工作表

MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
i = 0
Do While MyName <> ""
If MyName <> ActiveWorkbook.Name Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
i = i + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = MyName
Wb.Sheets(1).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wbn = Wbn & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop

将这些文件copy到一个文件夹（只有这些excel，且若打开某一文件，数据就能看见——即不用点其他sheet），建一新excel，把sheet1起名”空表“，其他sheet删除。也存到该文件夹。仅打开该新excel，按alt+f11，点菜单的插入，模块，粘贴如下代码： sub find() application.screenupdating = false dim mydir as string mydir = thisworkbook.path & "\" chdrive left(mydir, 1) 'find all the excel files chdir mydir match = dir$("") i = 1 do if not lcase(match) = lcase(thisworkbook.name) then workbooks.open match, 0 'open activesheet.copy before:=thisworkbook.sheets(1) 'copy sheet windows(match).activate activewindow.close activesheet.name ="sheet" & i i = i +1 match = dir$ end if loop until len(match) = 0 application.screenupdating = true end sub 点菜单上面的播放按钮，文件复制完成。