批量合並同一文件夾下工作簿-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

運行宏合並數據

 注：本次合並前提為合並內容表頭相同，下節出示表頭不同的解決方法。