I read the codes available on the network from various sources, and debugged self-learning programming to make it work, but I have difficulty continuing.
As you can see, it comes from the source. Browsing a folder and reading files work fine with the code, I need to copy the values from this folder and paste them into the default template, as indicated in the code, and save the file with the standard format and next to the values from cell (O1) and (O11) in code.
As you can see, it is not saved as xlsx, and none of them are saved with values from the specified cell.
Next, the automation of data entry in the designated field. Only the first 3 files can copy exactly what I want. The rest is entering incorrect data, as shown in the figure below. In addition, I also need to copy the values from cell N15: O83, read from the files in the folder, to the Column AA and AB template, starting from line 6. respectively.
Thanks in advance for your help.
Sample source file.
Correct automation. Incorrect automation.
Macrocode
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
source
share