EXCEL如何把同一个目录下多个工作薄合并到一个工作薄

【引⾔】

　　有的时候我们需要把某个⽬录下多个⼯作薄⽂件合并到⼀个⽂件，⽐如：⼀个⼩商店每个⽉都有⼀个以⽉份为名称的结算表，到了年底，可能需要把它们合成⼀个以年度为名称的⼯作薄，⼀是精简⽂件，⼆是⽅便管理，如何实现？(以下⽅法均针对需要合并的⼯作薄中都只有⼀个⼯作表)

【实现⽅法⼀】

　　如果⽂件名称是确定的，且有规律,⽐如合并1,2,3⽉到⼀季度,那么可以先新建⼀个空⽩⼯作薄，录制⼀个宏，把其中⼀个⼯作薄中⼯作表移动/复制到新⼯件薄中,再修改,此时我们可以得到以下代码

Sub 宏1()'

' 宏1 宏'

'

Workbooks.Open Filename:=\"C:\\Users\\hp\\Desktop\\1⽉.xlsx\" Sheets(\"Sheet1\").Select

Sheets(\"Sheet1\").Move After:=Workbooks(\"⼯作簿1\").Sheets(1)

　　 ActiveWorkbook.SaveAs Filename:=\"C:\\Users\\hp\\Desktop\\⼀季度.xlsm\

End Sub

　　然后我们把另外两个加进来就好,⽅法是复制并修改代码(这种⽅法对初学者⽐较适⽤)

Sub 宏1()'

' 宏1 宏'

'

Workbooks.Open Filename:=\"C:\\Users\\hp\\Desktop\\2⽉.xlsx\" '1⽉⼰加进来,处理后⾯两⽉就好 Sheets(\"Sheet1\").Select

Sheets(\"Sheet1\").Move After:=Workbooks(\"⼀季度\").Sheets(1) '⼯作薄名称⼰改变了,这⾥也跟着改,当然在第⼀步时也可以先不保存,这⾥就不⽤改了 Workbooks.Open Filename:=\"C:\\Users\\hp\\Desktop\\3⽉.xlsx\" Sheets(\"Sheet1\").Select

Sheets(\"Sheet1\").Move After:=Workbooks(\"⼀季度\").Sheets(1)

'ActiveWorkbook.SaveAs Filename:=\"C:\\Users\\hp\\Desktop\\⼀季度.xlsm\

ActiveWorkbook.Save '第⼀次没起名,⽤另存为,现在可以直接保存就好End Sub

　　⾄此,在⼀季度⼯作薄中便有四个⼯作表,多出来的⼀个是新建⼯作表时的空表。但我们发现两个问题：1.顺序是倒的 2.名称混乱。此两问题将在下⼀⽅法中⼀并处理

【实现⽅法⼆】

　　对于第⼀个⽅法,只有三个⽂件还好,⽂件多了也很⿇烦,⽐如1-12⽉合并到⼀年,这时我们可以使⽤循环,当然这需要我们懂⼀点VBA基础(不会也没关系,百度查查就好,前提是我们知道有\"循环\"这个概念)。当下需要处理的是⽂件名称和位置,它们每次都在变化,所以,可以⽤变量实现。

　　1.⽂件名称 可以⽤⼀个变量fn表⽰,它的原型是\"C:\\Users\\hp\\Desktop\\1⽉.xlsx\我们⾸先⽤⼀个计数器i(每循环都会加1),现在把\"1⽉\"中的\"1\"分离出来就可以了,fn=\"C:\\Users\\hp\\Desktop\\\" & 1 &\"⽉.xlsx\然后把那个1⽤变量i替换,即fn = \"C:\\Users\\hp\\Desktop\\\" & i & \"⽉.xlsx\这样随着i的改变,⽂件名称也跟着变了。

　　2.位置 在第⼀个⽅法⾥我们发现⼯作每次插⼊的位置都在第⼀个⼯作表之后,实际上应该在最后⽐较好,即第1次在第1个⼯作表之后,第2次就应该在第2个⼯作表之后,那很容易得知第i次应该在第i个⼯作表之后,亲爱的读者,你知道修改哪⾥了吗?(不知道的朋友请看代码)好吧,我们把刚才插⼊的⼯作全部删除,修改宏1的代码如下,再运⾏试试

Sub 宏1()'

' 宏1 宏'

'

For i = 1 To 3

fn = \"C:\\Users\\hp\\Desktop\\\" & i & \"⽉.xlsx\" Workbooks.Open Filename:=fn Sheets(\"Sheet1\").Select

Sheets(\"Sheet1\").Move After:=Workbooks(\"⼀季度\").Sheets(i) Next i

ActiveWorkbook.Save '第⼀次没起名,⽤另存为,现在可以直接保存就好End Sub

　　　　还有⼀个问题:⼯作的名称没有修改,我们可以把它修改为之前⼯作薄的名称,当然得去掉⽬录。这个问题不会的朋友可以百度,也可以单独录制⼀个修改⼯作表名称的宏查看代码,当然这⾥需要分离出⽬录和⽂件扩展名等,⼯作表名称只需要主要部分就可以了。直接上代码(注意代码中的红⾊部分)

Sub 宏1()'

' 宏1 宏

'mypath = \"C:\\Users\\hp\\Desktop\\\" For i = 1 To 3 fn = i & \"⽉\"

Workbooks.Open Filename:=mypath & fn & \".xlsx\" Sheets(\"Sheet1\").Select

Sheets(\"Sheet1\").Move After:=Workbooks(\"⼀季度\").Sheets(i) Sheets(i + 1).Name = fn Next i

ActiveWorkbook.Save '第⼀次没起名,⽤另存为,现在可以直接保存就好End Sub

【实现⽅法三】

　　　　如果⽂件名称没啥规律或者规律难以⽤变量+公式实现怎么办?这时,我们可以考虑⽤数组——把⽂件名全写⼊数组,再利⽤前⾯的循环。这时可以需要⼀些新的知道——字符串分割为数组(如果不会也可以直接单个输⼊)

Sub 宏1()'

' 宏1 宏'

'

mypath = \"C:\\Users\\hp\\Desktop\\\" Dim fn As Variant

fn = Array(\"\", \"1⽉\", \"2⽉\", \"3⽉\")

Rem 以下两⾏是上⾯两⾏的另⼀种等效实现⽅式 'Dim fn As String

'fn = Split(\⽉,2⽉,3⽉\数组下标⼀般从0开始,前⾯⼀个逗号⽬的是让第⼀个为空,真正要⽤的数据便从1开始 For i = 1 To 3

Workbooks.Open Filename:=mypath & fn(i) & \".xlsx\" Sheets(\"Sheet1\").Select

Sheets(\"Sheet1\").Move After:=Workbooks(\"⼀季度\").Sheets(i) Sheets(i + 1).Name = fn(i) Next i

ActiveWorkbook.Save '第⼀次没起名,⽤另存为,现在可以直接保存就好End Sub

【实现⽅法四】

　　如果需要处理的⽂件较多,⽂件名称还没啥规律,那么我们可以⽤这种⽅法。⾸先,我们先新建⼀个⼯作薄,并把⽂件另存为\"启⽤宏的⼯作薄\"(扩展名为.xlsm)。其次打开VBA编辑环境,插⼊类模块,新建⼀个程序。

Sub 合并⼯作表()

Application.ScreenUpdating = False '为了提⾼程序运算速度,关闭屏幕刷新mypath = \"C:\\Users\\hp\\Desktop\\\" '这时你可以换成你需要的⽬录fn = Dir(mypath & \"*.xlsx\")Do While fn <> \"\"

Workbooks.Open Filename:=mypath & fn

Sheets(1).Move After:=Workbooks(\"⼀季度\").Sheets(Workbooks(\"⼀季度\").Sheets.Count)

Sheets(Sheets.Count).Name = Left(fn, InStr(fn, \".\") - 1) '这⾥的fn是带扩展名的⽂件名,⼯作名称需要去掉.xlsx fn = DirLoop

'Sheets(1).Delete '第⼀个⼯作表是新建时默认添加的去掉ActiveWorkbook.Save '保存

Application.ScreenUpdating = True '程序运⾏完成,恢复屏幕刷新End Sub