我想實作把一個檔案夾下多個Excel檔案(每個檔案有多個sheet且名字不一樣)復制到模板里面,然后另存到指定檔案夾(另存Excel的名字和原Excel的名字一樣),形成回圈。現在單個檔案我可以實作,但是無法回圈。下面是我寫的回圈代碼,目前發現兩個問題1、兩個檔案無法轉換,2、每個檔案有多個sheet且名字不一樣,sheet名字也顯示錯誤無法實作。,因為沒有成功不知道還有沒有其他問題,請大神指正,謝謝,
Sub keylingc3()
Dim Path As String
Dim File As String
Dim wb As Workbook
Application.ScreenUpdating = False '凍結螢屏
Path = "C:\Users\13731\Desktop\預算\" '把目標檔案夾路徑賦值給變數,這里的路徑可以自己改
File = Dir(Path & "*.xlsx") '一次找尋路徑中的excel檔案,這里到底是.xlsx還是.xls,可以自己改
Do While File <> "" '當指定路徑中有檔案時進行回圈
Set wb = Workbooks.Open(Path & File) '打開符合要求的檔案
Call Workbooks.Open("C:\Users\13731\Desktop\新建檔案夾 (2)\模板 - 副本 - 副本.xlsx") '打開模板
Windows(" & File & ").Activate '點開要復制的檔案
Sheets(Array("表一", "表二", "表三甲", "表三丙", "表四(國內材料表)", "表四(設備表)", "表五")).Select '呼叫你的另一端對每個excel檔案進行具體操作的宏,也可以直接寫到這個宏中
Sheets("表一").Activate '移動所有sheet
Sheets(Array("表一", "表二", "表三甲", "表三丙", "表四(國內材料表)", "表四(設備表)", "表五")).Move Before:= _
Workbooks("模板 - 副本 - 副本.xlsx").Sheets(1) '移動到模板檔案
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete '洗掉模板檔案多余的Sheet
Sheets("表一").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\13731\Desktop\新建檔案夾 (3)\" & File & "", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Application.WindowState = xlNormal '另存名字為原來的檔案名字
ActiveWindow.Close '關閉檔案
File = Dir '找尋下一個excel檔案
Loop
Application.ScreenUpdating = True '解凍螢屏
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/147070.html
標籤:VBA
上一篇:求解,Win環境下面程式讀取檔案的路徑認,然后按照需要的順序輸出
下一篇:軟體自動升級程式的問題。
