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

Copper Contributor

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.

1 Reply

@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.