Copy data from workbook paste into another template and SaveAs for files in folder

mickeymao 

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.