Loop folder, copy csv and assign new filename

[ryan8200]

Hi All Member,
I have 2 csv files in download folder and I would like to copy each file twice to current workbook and rename them accordingly.
File 1: Western => Rename to Western_Q1 and Western_Q2
File 2: Eastern => Rename to Eastern_Q1 and Eastern_Q2

I tried the following code, but it tends to copy 4 times for File 1

Sub CopyFiles()

    Dim wb As Workbook
    Dim FSO As Object, Folder As Object, file As Object
    Dim Region As Variant, Quarter As Variant
   
    Set wbMstr = ThisWorkbook
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder("C:\Users\My\Downloads\")
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
   
    For Each file In Folder.Files
    
        Set wb = Workbooks.Open(Filename:=file, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
             
        For Each Region In Array("Western", "Eastern")
              For Each Quarter In Array("Q1", "Q2")
            
             wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
             ActiveSheet.Name = Region & "_" & Quarter
            Next Quarter 
        Next Region
        
        wb.Close False
    Next

End Sub

 

[Fluff]

How about

    For Each file In Folder.Files
    
        Set wb = Workbooks.Open(Filename:=file, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
             
              For Each Quarter In Array("Q1", "Q2")
            
             wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
             ActiveSheet.Name = wb.Sheets(1).Name & "_" & Quarter
            Next Quarter
        
        wb.Close False
    Next

 

[ryan8200]

How about

    For Each file In Folder.Files
   
        Set wb = Workbooks.Open(Filename:=file, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
            
              For Each Quarter In Array("Q1", "Q2")
           
             wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
             ActiveSheet.Name = wb.Sheets(1).Name & "_" & Quarter
            Next Quarter
       
        wb.Close False
    Next

Hi Fluff thanks for your valuable input. The csv file provided different source did not match my expectation. How should I assign first file (wb.Sheets(1).Name) to Western and second file to Eastern ?

 

[Fluff]

Are the two files called Western & Eastern?

 

[ryan8200]

Are the two files called Western & Eastern?

The filename for these 2 csv files are dynamic due to different senders. Eg:
Sender 1: Western_File, Eastern_File
Sender 2: Data_1, Data_2
But I would like to rename first csv as Western and 2nd csv as Eastern. Is this something can be achieved using VBA ?

 

[Fluff]

How would you know which is which?

 

[ryan8200]

How would you know which is which?

Normally, the first file will be Western and 2nd file will be Eastern

 

[Fluff]

Ok, how about

Sub CopyFiles()

    Dim wb As Workbook
    Dim FSO As Object, Folder As Object, file As Object
    Dim Region As Variant, Quarter As Variant
    Dim i As Long
    
    Set wbMstr = ThisWorkbook
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder("C:\Users\My\Downloads\")
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
   
   For Each file In Folder.Files
      If i = 0 Then Region = "Western" Else Region = "Eastern"
      i = i + 1
      Set wb = Workbooks.Open(Filename:=file, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
      
      For Each Quarter In Array("Q1", "Q2")
      
         wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
         ActiveSheet.Name = Region & "_" & Quarter
      Next Quarter
      
      wb.Close False
   Next

End Sub