我有一个名为 !PaymentTemplate.xlsx 的文件和一个包含许多文件的名为“Output”的文件夹。我想遍历 Output 文件夹中的每个文件并将数据复制到 !PaymentTemplate.xlsx 文件中，然后保存该模板文件。我不想附加数据，只需复制并粘贴它，然后将该文件另存为新名称，然后从原始 !PaymentTemplate.xlsx 文件重新开始。示例：输出文件夹中名为“Sunrise.xlsx”的文件，宏应该打开它，将数据复制到 !PaymentTemplate.xlsx 并另存为 Sunrise_New.xlsx。然后转到下一个文件并在 !PaymentTemplate.xlsx 文件中执行相同的操作。
如果我在输出目录中有 10 个文件，那么应该有 10 个新文件以“_New”作为文件名的一部分。
下面是我编写的一个宏，但无法将 fileName 变量作为另存为导出的一部分并对其进行测试。
Sub Energy_Template()
'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Dan\Energy Commission\raw data\TEmplate for Upload\Output\")
While fileName <> ""
Workbooks.Open fileName:= _
"C:\Dan\Energy Commission\raw data\TEmplate for Upload\!PaymentTemplate.xlsx"
Workbooks.Open fileName
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("!PaymentTemplate.xlsx").Activate
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ChDir "C:\Dan\Energy Commission\raw data\TEmplate for Upload\new ouput"
ActiveWorkbook.SaveAs fileName:= _
"C:\Dan\Energy Commission\raw data\TEmplate for Upload\new ouput\Sunrise_New.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
ActiveWindow.Close
'Set the fileName to the next file
fileName = Dir
Wend
End Sub
谢谢！
试试这个代码：
Sub Energy_Template()
Const outputFolderPath As String = "C:\Dan\Energy Commission\raw data\TEmplate for Upload\Output"
Const templateFilePath As String = "C:\Dan\Energy Commission\raw data\TEmplate for Upload\!PaymentTemplate.xlsx"
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim loopFile As Object
For Each loopFile In FSO.GetFolder(outputFolderPath).Files
If FSO.GetExtensionName(loopFile.Name) = "xlsx" And Left$(loopFile.Name, 2) <> "~$" Then
Dim outputWB As Workbook
Set outputWB = Application.Workbooks.Open(loopFile.Path)
Dim templateWB As Workbook
Set templateWB = Application.Workbooks.Open(templateFilePath)
Dim copyRng As Range
Dim copyLastRow As Long
copyLastRow = outputWB.Worksheets(1).Range("A2").End(xlDown).Row
Set copyRng = outputWB.Worksheets(1).Range("A2:A" & copyLastRow).EntireRow
copyRng.Copy
templateWB.Worksheets(1).Range("3:3").Insert xlShiftDown
Dim saveName As String
saveName = Replace(outputWB.Name, ".", "_New.")
Application.DisplayAlerts = False
templateWB.SaveAs outputFolderPath & "\" & saveName
templateWB.Close
Set templateWB = Nothing
outputWB.Close 0
Set outputWB = Nothing
Application.DisplayAlerts = True
End If
Next loopFile
End Sub
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句