vba复制文件,文件已知,但不知道怎么复制

文件清单 14

C:\test\新建 Microsoft Office Excel 工作表.xlsx

C:\test\新建 文本文档.txt

C:\test\1\新建 360压缩 ZIP 文件.zip

C:\test\1\新建 Microsoft Office Excel 工作表.xlsx

C:\test\1\新建 Microsoft Office Publisher 文档.pub

C:\test\2\新建 BMP 图像.bmp

C:\test\2\新建 Microsoft Office Word 文档.docx

C:\test\3\新建 文本文档.txt

C:\test\4\4.7z

C:\test\5\23.txt

C:\test\test1\12345.pub

C:\test\test2\456.pub

C:\test\test3\scz.pptx
excel A列的清单,有路径+文件名,如上,
问:如何复制每一个文件到路径"'C:\123"?

Option Explicit
Sub filecopy()
    Dim list As Integer
    Dim i As Integer
    Dim spath As String
    Dim tpath As String
    Dim trr As Variant
    Dim u As Integer
    list = ActiveSheet.[a4000].End(xlUp).Row
    For i = 1 To list
        spath = ActiveSheet.Range("a" & i).Value
        trr = Split(spath, "\")
        u = UBound(trr)
        tpath = "C:\123\" & trr(u)
        filecopy spath, tpath
    Next i
End Sub

建议不要直接打开所有包含指定字符的文件. 下面的代码会把找到的所有包含指定字符的文件名装入一个数组 显示出来让你选择打开一个你指定的. sub myopen() dim ipath as string, myfile, filearr(), n as integer '选择在哪个文件夹中查找 with application.filedialog(msofiledialogfolderpicker) .show ipath = .selecteditems(1) end with myfile = dir(ipath & "\abc*.xls") do while myfile <> "" n = n + 1 redim preserve filearr(1 to n) filearr(n) = n & "." & myfile myfile = dir loop if n < 1 then msgbox "没有找到符合条件的文件!" exit sub end if sfile = application.inputbox(join(filearr, vbcrlf), "请输入要打开的文件序号:", type:=1) if sfile = false then exit sub workbooks.open (ipath & "\" & split(filearr(sfile), ".")(1)) '打开选定序号的文件 end sub ps:关于获得已打开的工作薄的文件名 sub test() '获得激活工作薄的名称 a = activeworkbook.name '获得这个工作薄的名称 b = thisworkbook.name '获得所有已打开的工作薄的名称 dim wb as workbook for each wb in workbooks c = wb.name '监视c变量,c变量会逐个赋值为所有已打开的工作薄的名称 next end sub