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", FileFormat _:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

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", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
    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(",1月,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 = Dir
Loop
'Sheets(1).Delete  '第一个工作表是新建时默认添加的去掉
ActiveWorkbook.Save '保存
Application.ScreenUpdating = True '程序运行完成,恢复屏幕刷新

End Sub