Dec 13 2023 12:30 PM - edited Dec 13 2023 12:37 PM
Hi all,
I have a template I want to copy from each files in a folder2 (100 files).
After done pasting on that template, save each file as the same name as folder2.
I am able to do this if I change the path for Workbooks.open
As I have 100 files i need to do this many times, any way I can loop the files from folder2 properly?
I can't saveAs for the template also.
Sub test()
Dim WS_Source As Worksheet
Dim WS_Destination As Worksheet
Dim last_row As Integer
Dim Last_Row_Position As Integer
Dim path As String
Dim wbk As Workbook
Set wbk = Workbooks.Open("C:\Users\Jean\AA_Results\AA_Result.csv")
'Naming each workbook
Set WS_Source = Workbooks("AA_Result.csv").Sheets("AA_Result")
Set WS_Destination = Workbooks("Template1.xlsx").Sheets("listings")
'Get last empty row of source workbook
last_row = WS_Source.Cells(WS_Source.Rows.Count, "A").End(xlUp).Row
'Get last empty row of destination workbook
Last_Row_Position = WS_Destination.Cells(WS_Destination.Rows.Count, "A").End(xlUp).Row + 1
'Copy from source and paste onto destination
WS_Source.Range("F2:F" & last_row).Copy WS_Destination.Range("F" & Last_Row_Position)
WS_Source.Range("E2:E" & last_row).Copy WS_Destination.Range("C" & Last_Row_Position)
WS_Source.Range("H2:H" & last_row).Copy WS_Destination.Range("H" & Last_Row_Position)
WS_Destination.Range("F2:F1048576").NumberFormat = "d/m/yyyy h:mm"
WS_Destination.Range("H2:H1048576").NumberFormat = "d/m/yyyy h:mm"
path = wbk.path & "\"
wbk.SaveCopyAs Filename:=path & WS_Destination.Name & ".xlsx"
Application.DisplayAlerts = True
End Sub
Another requirement is to concatenate each files in folder2.
https://websphere.net/t5/UID?=123456789
123456789 will come from column B in each file in folder2.
For each file in folder2, add the URL & column B into a new column.
Appreciate if there's anyone who has the solution. Thank you.
Dec 13 2023 11:51 PM
To achieve the task of looping through files in a folder, copying data from each file, and saving it with a new name, you can use the following VBA code. Additionally, I've added the code for concatenating the URL with the values from column B in each file.
Vba code (is untested, please backup your file):
Sub ProcessFilesInFolder()
Dim FolderPath As String
Dim FileName As String
Dim WS_Source As Worksheet
Dim WS_Destination As Worksheet
Dim LastRow As Long
Dim LastRowPosition As Long
Dim PathToSave As String
Dim wbk As Workbook
' Specify the folder path
FolderPath = "C:\Users\Jean\Path\To\Folder2\"
' Loop through each file in the folder
FileName = Dir(FolderPath & "*.csv")
Do While FileName <> ""
' Open the workbook
Set wbk = Workbooks.Open(FolderPath & FileName)
' Naming each workbook
Set WS_Source = wbk.Sheets("AA_Result")
Set WS_Destination = Workbooks("Template1.xlsx").Sheets("listings")
' Get last empty row of source workbook
LastRow = WS_Source.Cells(WS_Source.Rows.Count, "A").End(xlUp).Row
' Get last empty row of destination workbook
LastRowPosition = WS_Destination.Cells(WS_Destination.Rows.Count, "A").End(xlUp).Row + 1
' Copy from source and paste onto destination
WS_Source.Range("F2:F" & LastRow).Copy WS_Destination.Range("F" & LastRowPosition)
WS_Source.Range("E2:E" & LastRow).Copy WS_Destination.Range("C" & LastRowPosition)
WS_Source.Range("H2:H" & LastRow).Copy WS_Destination.Range("H" & LastRowPosition)
WS_Destination.Range("F2:F1048576").NumberFormat = "d/m/yyyy h:mm"
WS_Destination.Range("H2:H1048576").NumberFormat = "d/m/yyyy h:mm"
' Build the path to save the new workbook
PathToSave = FolderPath & Replace(wbk.Name, ".csv", "") & ".xlsx"
' Save the workbook as a new file
wbk.SaveCopyAs Filename:=PathToSave
' Close the source workbook without saving changes
wbk.Close SaveChanges:=False
' Concatenate URL with column B and add to a new column
ConcatenateURL FolderPath, FileName
' Move to the next file in the folder
FileName = Dir
Loop
' Display a message when the process is complete
MsgBox "Processing completed successfully!", vbInformation
End Sub
Sub ConcatenateURL(FolderPath As String, FileName As String)
Dim WS_Source As Worksheet
Dim LastRow As Long
' Open the workbook
Set wbk = Workbooks.Open(FolderPath & FileName)
Set WS_Source = wbk.Sheets("AA_Result")
' Get last empty row of source workbook
LastRow = WS_Source.Cells(WS_Source.Rows.Count, "B").End(xlUp).Row
' Concatenate URL with column B and add to a new column (assuming the URL is in column C)
WS_Source.Range("C2:C" & LastRow).Formula = "=HYPERLINK(""https://websphere.net/t5/UID?=""&B2,""Link"")"
' Save the changes and close the workbook
wbk.Save
wbk.Close SaveChanges:=False
End Sub
Please make sure to update the folder path in the FolderPath variable. This code assumes that the URL should be added to column C in each file, starting from row 2. Adjust the code accordingly based on your specific requirements. The text/steps was created/Translate with the help of AI.
Hope this will help you.
Was the answer useful? Mark as best response and like it!
This will help all forum participants.