批量合并同一文件夹下工作簿-1

描述：同一文件夹下有多个工作簿，且表结构相同，需要把文件夹下的各个工作表的内容合并到同一工作簿中。

在文件夹下新建工作表，在新建工作表下插入宏。

sub hbwb()

dim r as integer,c as interger,r1 as integet,c1 as integer

dim filename as string,filepath as string,workbook_name as string

dim wb as workbook

application.screenupdating=False

filename=thisworkbook.name

filepath=thisworkbook.path

workbook_name=thisworkbook.name

'msgbox(filename & chr(13) & filepath)

na=dir(thisworkpath & "/.xlsx")

do while na <> ""

　　if na <> filename then

　　in_row=sheets(1).range("a65536").end(xlup).row+1   '取得空行行号

　　filepath_na=filename & '\' &na

　　set wb = getobject(filepath_na)

　　set sht =wb.sheets(1)

　　r=1

　　c=2

　　r1=sht.range('a65536').end(xlup).row

　　c1=sht.cells(1,200).end(xltoleft).column

　　copy_cont=sht.range(sht.cells(1,1),sht.cells(r1,c1))

　　sheets(1).cells(in_row).resize(r1,c1)=copy_cont

　　end if 

　　na=dir

loop
set wb = nothing
application.screenupdating=True

end

运行宏合并数据

 注：本次合并前提为合并内容表头相同，下节出示表头不同的解决方法。