Excel浏览文件夹并将数据input自动化到默认模板中

我一直在从网上阅读各种来源的代码，并通过自学的编程进行debugging，使其工作，但我有困难继续前进。

正如你所看到的，它来自一个来源。 浏览文件夹和阅读文件的代码工作正常，我需要从这个文件夹中复制值，并粘贴到代码中分配的默认模板和保存文件与默认格式和旁边的单元格的值（O1 ）＆（O11）在代码中分配。

如您所见，不会保存为xlsx，也不会使用指定单元格中的值进行保存。

接下来，自动将数据input到指定字段。 只有前3个文件能够正确地复制我想要的。 其余的则input错误的数据，如下图所示。 此外，我还需要从文件夹中的文件中读取单元格N15：O83中的值，并将其分别从第6行开始复制到模板列AA和AB中。

预先感谢您提供的任何帮助。

示例源文件 正确的自动化 错误的自动化

macros代码

Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim InstID As String Dim InstDate As Date Dim InstBR As String 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Ensure Workbook has opened before moving on to next line of code DoEvents 'Input Code Here InstID = Range("O1") InstDate = Range("O11") InstBR = "Base Reading" wb.Worksheets(1).Range("B15:E83").Copy Workbooks.Add template:="C:\Users\PC1\Desktop\Daily data file\Inc\TestTemplate.xlsx" Sheets(ActiveSheet.Index + 1).Activate If Err.Number <> 0 Then Sheets(1).Activate Range("M6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E6:F76") = InstID Range("K6:K76") = InstDate Range("J6") = InstBR ChDir ("C:\Users\PC\Desktop\Daily data file\Inc\INC22001 - Copy\Test Save") ' Directory you need to save the file as xlsm Filename = ("Test_Data_ ") & Range("O1").Value & ";" & Range("O11").Value ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook 'Save and Close Workbook wb.Close SaveChanges:=True 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

Answer 1

这看起来有问题

 Filename = ("Test_Data_ ") & Range("O1").Value & ";" & Range("O11").Value ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook 

你需要添加

 & ".xlsx" 

到顶部行的末尾以正确形成工作簿文件名。

Answer 2

根据以前的答案，你将需要给你的文件一个扩展名。 而且，你正在轻松地引用你的范围O1和O11（意思是你没有指定一张纸）。 如果这些值需要来自您正在打开的文件，我会明确地引用它们与wb.Worksheets(1).Range("O1").Value 。 从外观上看，你无意中从目标工作表中获取这些值（请参见截图2中的单元格O11，截图1中的第四个文件）。

我也会非常谨慎地把原始date放在一个文件名中。 Filename = "Test_Data_ " & InstID & ";" & Format(InstDate,"YYYYMMDD") & ".xlsx"会更好： Filename = "Test_Data_ " & InstID & ";" & Format(InstDate,"YYYYMMDD") & ".xlsx" Filename = "Test_Data_ " & InstID & ";" & Format(InstDate,"YYYYMMDD") & ".xlsx"

Answer 3

嗨请纠正我，如果我错了。 好的，我的理解是基于你的解释。

首先你有一个模板（wbTemplate），然后你需要打开一套其他的工作簿，并根据给定的模板进行预先格式化，然后将其保存到目标path中。

你需要练习dynamic地设置所有的对象。

我在每一行都加上评论，这样你就可以理解它是如何工作的。

{

  Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wbTemplate As Workbook, wbSourceFile As Workbook Dim wsTemplate As Worksheet, wsSourceFile As Worksheet Dim SourceFileEndRow As Long, TemplateEndRow As Long Dim myPath As String, myFile As String 'This is where the Source File located Dim myExtension As String Dim FldrPicker As FileDialog Dim InstID As String Dim InstDate As Date Dim InstBR As String Dim targetPath As String 'Set this to where you want to save all the output files Set wbTemplate = ThisWorkbook Set wsTemplate = ThisWorkbook.Sheets(1) ' Input the Index no. of your Template, or much better to rename it based on the Name of the Template Tab targetPath = "C:\Users\Enrerol\Desktop\Tester\TargetPath\" 'Set where you want to save your Output File 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wbSourceFile = Workbooks.Open(Filename:=myPath & myFile) ' Set our SourceFile Set wsSourceFile = wbSourceFile.Worksheets(1) 'Set the Worksheet that we are copying 'Ensure Workbook has opened before moving on to next line of code DoEvents 'Input Code Here InstID = wsSourceFile.Range("O1") InstDate = wsSourceFile.Range("O11") InstBR = "Base Reading" SourceFileEndRow = wsSourceFile.Range("B" & Rows.Count).End(xlUp).Row ' This to make sure that you have a dynamic range; it will get the last row used of the Source File wsSourceFile.Range("B15:E" & SourceFileEndRow).Copy Destination:=wsTemplate.Range("M6") TemplateEndRow = wsTemplate.Range("M" & Rows.Count).End(xlUp).Row 'We will get the last used row of our Destination Column wsTemplate.Range("E6:F" & TemplateEndRow) = InstID wsTemplate.Range("K6:K" & TemplateEndRow) = InstDate wsTemplate.Range("J6") = InstBR Filename = ("Test_Data_") & InstID & "_" & Format(InstDate, "m_d_yyyy") ' You need to change this, because there will be an error on your existing format. Specially the instdate is Formated as "dd/mm/yyyy" Application.DisplayAlerts = False 'We will need to stop the prompting of the excel application wbTemplate.SaveAs Filename:=targetPath & Filename, FileFormat:=xlOpenXMLWorkbook Application.DisplayAlerts = True 'Reset application Values 'Save and Close Workbook wbSourceFile.Close SaveChanges:=True wsTemplate.UsedRange.Delete 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub