假日咖啡的博客

HolidayCoffee's Blog

Execl多个xls文件转为表单合并在一个xls文件下VBS脚本


这是一个极其简单的自动操作脚本,运行此脚本前确认已经新建了一个空的XLS文件并在打开状态!

该脚本在office2007版的excel下测试可以用。

Sub Macro3()
'在这里输入包含所有xls的文件夹地址
FilesTree ("C:UsersAdministratorDesktopcms配置表")

End Sub


Function FilesTree(sPath)
  Dim i: i = 0
  Dim u
  
  On Error Resume Next
  Set oFso = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFso.GetFolder(sPath)
  Set oFiles = oFolder.Files
  For Each oFile In oFiles
      If Right(oFile.Path, 3) = "xls" Then
      
      
      
        
     
        Workbooks.Open Filename:=oFile.Path
        Workbooks(2).Activate
        Cells.Select
        Selection.Copy

       u = u & Replace(oFile.Path, sPath, "")
       u = Replace(u, ".xls", "")
       u = Replace(u, "", "")
       
       Workbooks(1).Activate

       Sheets.Add After:=Sheets(Sheets.Count)
      
       Sheets(Sheets.Count).Select
       Sheets(Sheets.Count).Name = u
       Sheets(Sheets.Count).Select
       Cells.Select
       ActiveSheet.Paste
       Application.CutCopyMode = False
        
        Workbooks(2).Close
        u = ""

         i = i + 1
      End If
  Next
  
  
  MsgBox ("您的" & sPath & "目录下,一共存在" & i & "个Excle文件")
  Wscript.Quit
End Function