复制原文件并重命名

一一如终

代码如下

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    wj = [a2]
    f = Dir(ThisWorkbook.Path & "\" & wj & ".pdf") '
    If f = "" Then MsgBox "找不到" & wj: End
    r = Cells(Rows.Count, 3).End(xlUp).Row
    ar = Range("c1:d" & r)
    For i = 1 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            mc = ar(i, 1) & ".pdf"
            fso.copyfile ThisWorkbook.Path & "\" & f, ThisWorkbook.Path & "\" & mc
        End If
    Next i
    Application.ScreenUpdating = True
End Sub


一个原文件要进行多个命名，这个代码会实现一个原文件可以复制多个并进行命名，但是如果多个原文件，新命名的文件都会是A2这份文件的。
如A2是原文件名文件，C2-C6是要新命名的
A7是原文件名文件，C7-C11是要新命名的
但是C7-C11的命名都会用A2这个文件来命名

ykcbf1100

文件复制并改名。