Home > OS >  VBA - Copy Mutiple File (After Download 1..2..3..) by Count into a Folder
VBA - Copy Mutiple File (After Download 1..2..3..) by Count into a Folder

Time:04-17

I have need help to copy multiple file into a folder after download.

The file after download default rename as:

  • Branch_A.xlsx
  • Branch_A (1).xlsx
  • Branch_A (2).xlsx

Here code normally i use but this code only copy one file to a folder. I need the code can capture words "Branch_A" then count file and copy to folder Branch_A. The count file is fix 3 its will come 4..5..6..

Sub down1()
'RENAME FILE DOWNLOAD BY BRANCHES

Dim Ws As Worksheet
Dim FromPath As String
Dim ToPath As String

    
Set Ws = ThisWorkbook.Worksheets("Path_Down1")

'FROM DOWNLOAD - C:\Users\Downloads\
FromPath = Ws.Range("E11").Value

'TO FOLDER - D:\Inbound\Branch_A\
ToPath = Ws.Range("F11").Value

Ws.Activate
FileCopy FromPath, ToPath


End Sub

I search few website and found that the code can count the file base on extention but i don't know how to edit to count by name and copy to folder. Here sample code:

Sub sample()

    Dim FolderPath As String, path As String, count As Integer
    FolderPath = "C:\Documents and Settings\Santosh\Desktop"

    path = FolderPath & "\*.xls"

    Filename = Dir(path)

    Do While Filename <> ""
       count = count   1
        Filename = Dir()
    Loop

    Range("Q8").Value = count
    'MsgBox count & " : files found in folder"
End Sub

Thanks for your help.

CodePudding user response:

Is the code below something you're looking for? This is what I could come up with what made sense to me. If not please provide more information as to what the issue is.

Sub Down1()

    Dim FromFolder As String, ToFolder As String
    Dim FromPath As String, ToPath As String, ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Path_Down1")
    FromFolder = ws.Range("E11").Value
    ToFolder = ws.Range("F11").Value
    Filename = Dir(FromFolder & "\*.xlsx")
    
    Do While Filename <> ""
        If InStr(Filename, "Branch_A") > 0 Then
            FromPath = FromFolder & "\" & Filename
            ToPath = ToFolder & "\" & Filename
            
            FileCopy FromPath, ToPath
        End If
        Filename = Dir()
    Loop
    
End Sub
  •  Tags:  
  • vba
  • Related