VBA to copy the master file workbook 500 times with different file names

[chris1979]

Hi Guys
Could you please assist me

I have a master workbook that needs to be copied 500 times with different file names based on a list.

I have used the following code

Sub CopyAndRenameFiles_3()

' Define variables
Dim MasterFilePath As String
Dim NewFilePath As String
Dim FileListFile As String
Dim FileListSheet As String
Dim FileListRange As String
Dim i As Integer
Dim NewFolder As String
Dim FileList() As String
Dim FileNumber As Integer
Dim FileLine As String

' Set the path to the master file
MasterFilePath = "C:\Users\C.Terrence\Downloads\SourceFiles\Masterfile.xlsm"

' Set the path to the file containing the list of file names
FileListFile = "C:\Users\C.Terrence\Downloads\Newfile\FileList.xlsx"

' Set the sheet name and range containing the list of file names
FileListSheet = "Sheet1"
FileListRange = "A1:A3" ' Assumes the file names are in cells A1 to A3

' Set the path to the new folder
NewFolder = "C:\Users\C.Terrence\Downloads\New\"

' Create the new folder if it doesn't exist
If Dir(NewFolder, vbDirectory) = "" Then
MkDir NewFolder
End If

' Open the file containing the list of file names
FileNumber = FreeFile()
Open FileListFile For Input As #FileNumber

' Loop through each line in the file and add it to the FileList array
i = 0
While Not EOF(FileNumber)
Line Input #FileNumber, FileLine
ReDim Preserve FileList(i)
FileList(i) = FileLine
i = i + 1
Wend

' Close the file
Close #FileNumber

' Loop through the list of file names and copy the master file
For i = LBound(FileList) To UBound(FileList)

' Define the new file path
NewFilePath = NewFolder & FileList(i)

' Copy the master file to the new file path
On Error Resume Next
FileCopy MasterFilePath, NewFilePath
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & ": " & Err.Description & " for file " & NewFilePath
End If
On Error GoTo 0

Next i

End Sub

But I am getting an error " Bad file name or number" in line "FileCopy MasterFilePath, NewFilePath"

Please assist

CT

 

[I_know_nuffin]

have you added a watch to the NewFilePath to see what it contains

or add

debug.print NewFilePath
stop

after its been defined to view it in the immediate window

 

[chris1979]

Thank you for the reply

Attached is the screenshot of the error.

 

[I_know_nuffin]

try the below just change the paths [ C:\Users\Public\Documents\ ] to suit your paths

Sub CopyAndRenameFiles_3()

' Define variables
Dim MasterFilePath As String
Dim NewFilePath As String
Dim FileListFile As String
Dim FileListSheet As String
Dim FileListRange As String
Dim NewFolder As String
Dim FileList() As String
'Dim FileNumber As Integer
'Dim FileLine As String
Dim flst As Workbook
Dim rng As Range, cel As Range

' Set the path to the master file
MasterFilePath = "C:\Users\Public\Documents\Masterfile.xlsx"

' Set the path to the file containing the list of file names
FileListFile = "C:\Users\Public\Documents\FileList.xlsx"

' Set the sheet name and range containing the list of file names
FileListSheet = "Sheet1"
FileListRange = "A2:A16" ' Assumes the file names are in cells A1 to A16

' Set the path to the new folder
NewFolder = "C:\Users\Public\Documents\New\"

' Create the new folder if it doesn't exist
If Dir(NewFolder, vbDirectory) = "" Then
MkDir NewFolder
End If

' Open the file containing the list of file names
Set flst = Workbooks.Open(FileListFile)

Set rng = flst.Sheets(FileListSheet).Range(FileListRange)

' Loop through each line in the file and save the main file
For Each cel In rng

' Define the new file path
NewFilePath = NewFolder & cel

' Copy the master file to the new file path
On Error Resume Next
FileCopy MasterFilePath, NewFilePath
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & ": " & Err.Description & " for file " & NewFilePath
End If
On Error GoTo 0

Next

End Sub