Sub Macro1() Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m& Set sh = ActiveSheet MyPath = ThisWorkbook.Path & "\" MyName = Dir(MyPath & "*.xls") Application.ScreenUpdating = False Cells.ClearContents Do While MyName <> "" If MyName <> ThisWorkbook.Name Then With GetObject(MyPath & MyName) For Each sht In .Sheets If IsSheetEmpty = IsEmpty(sht.UsedRange) Then m = m + 1 If m = 1 Then sht.[a1].CurrentRegion.Copy sh.[a1] Else sht.[a1].CurrentRegion.Copy sh.[a65536].End(xlUp).Offset(1) End If End If Next .Close False End With End If MyName = Dir Loop Application.ScreenUpdating = True End Sub
在第四行 MyName = Dir(MyPath & "*.xls") 将*.xls修改为*.xlsx和*.csv可分别合并07版本以后的Excel文件和csv文件
步骤:
1、先把将要合并的多个Excel文档放在同一个文件夹中,然后再文件夹中创建一个新的Excel文档并打开
2、在sheet1工作表右键点击“查看代码”,将上面的代码粘贴进去
3、代码窗口的菜单栏点击“运行”--“运行子过程/用户窗体”或者直接按F5
就可以看到合并后的数据呈现在新的工作表中,点击保存,可能会出现下图的情况.....点击“是”