xls另存为xlsx
在要合并和文件同级目录下, 新建一个Excel文件,按 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。
'***********访问当前文件夹下所有子文件夹及文件,
Dim iFile(1 To 100000) As String
Dim count As Integer
Sub xls2xlsx()
iPath = ThisWorkbook.Path
On Error Resume Next
count = 0
zdir iPath
For i = 1 To count
If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
MyFile = iFile(i)
FilePath = Replace(MyFile, ".xls", ".xlsx")
If Dir(FilePath, 16) = Empty Then
Set WBookOther = Workbooks.Open(MyFile)
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
WBookOther.Close SaveChanges:=False '解决不能close 文件问题
Application.ScreenUpdating = True
End If
End If
Next
End Sub
Sub zdir(p) '访问当前文件夹下所有子文件夹及文件
Set fs = CreateObject("scripting.filesystemobject")
For Each f In fs.GetFolder(p).Files
If f <> ThisWorkbook.FullName Then count = count + 1: iFile(count) = f
Next
For Each m In fs.GetFolder(p).SubFolders
zdir m
Next
End Sub
合并多个文件是一个文件的多个sheet
新建一个Excel文件,按 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。
合并后,查看sheet总数:
在任意一个单元格输入函数
=INFO("numfile")
Sub CombineWorkbooks()
Dim FilesToOpen, ft
Dim x As Integer
Application.ScreenUpdating = False
On Error GoTo errhandler
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Micrsofe Excel文件(*.xlsx), *.xlsx", _
MultiSelect:=True, Title:="要合并的文件")
If TypeName(FilesToOpen) = "boolean" Then
MsgBox "没有选定文件"
'GoTo errhandler
End If
x = 1
While x <= UBound(FilesToOpen)
Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
wk.Sheets().Move after:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
MsgBox "合并成功完成!"
errhandler:
'MsgBox Err.Description
'Resume errhandler
End Sub