I been reading up codes available on the net from various sources and have debug with self-taught programming to make it work but I'm having difficulty proceeding on.
As you can see, it comes from a source. Browsing a folder & reading the files works fine with the code, I need to copy values from this folder & paste it into the default template as assigned in the code & save the file with with a default format and alongside values from a cell(O1) & (O11) assign in the code.
As you can see, is not saved as xlsx and neither is it saving with the values from cell specified.
Next, automating data entry to assigned field. Only first 3 files are able to copy exactly what I want. The rest inputs wrong data, as shown in the image below. Additionally, I also need to copy values from cell N15:O83 read from files in folder, into template Column AA & AB starting from row 6 respectively.
Thanks in advance for any assistance provided.
Sample Source File 
Correct Automation 
Wrong Automation 
Macro Code
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 3 Answers
Answers 1
This looks problematic
Filename = ("Test_Data_ ") & Range("O1").Value & ";" & Range("O11").Value ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook you need to add
& ".xlsx" to the end of the top line to correctly form the workbook filename.
Answers 2
As per the previous answer, you will need to give your file an extension. But also, you are referencing your Ranges O1 and O11 softly (meaning your not specifying a sheet). If these values need to come from the file you are opening, I would reference them explicitly with wb.Worksheets(1).Range("O1").Value. By the looks of it, you are inadvertently getting these values from the target sheet (see cell O11 in screenshot 2 and your fourth file down in screenshot 1).
I would also be very cautious about putting a raw date in a filename. You would be better with a datestamp: Filename = "Test_Data_ " & InstID & ";" & Format(InstDate,"YYYYMMDD") & ".xlsx"
Answers 3
Hi Please correct me if I'm wrong. Okay here's the thing that I understand based on your explanation.
First you have a Template (wbTemplate), and then a set of other workbooks that you need to open and pre-format it based on the template given then save it on your target path.
You need to practice in setting all your objects dynamically.
I put comments on every line so you may understand how this works.
{
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 
0 comments:
Post a Comment