提示:其他語言是Google翻譯的。 你可以訪問 English 版本。
登入
x
or
x
x
註冊
x

or

如何基於Excel中的列表將文件從一個文件夾複製或移動到另一個文件夾?

如果您在工作表中的列中有文件名列表,並且這些文件位於您的計算機中的文件夾中。 但是,現在,您需要將這些名稱列在工作表中的文件從其原始文件夾移動或複製到另一個文件夾中,如下面的屏幕截圖所示。 你怎麼能盡快完成這項任務,你可以在Excel中?

使用VBA代碼基於Excel中的列表將文件從一個文件夾複製或移動到另一個文件夾


使用VBA代碼基於Excel中的列表將文件從一個文件夾複製或移動到另一個文件夾


要根據文件名列表將文件從一個文件夾移動到另一個文件夾,以下VBA代碼可能對您有幫助,請按照以下步驟操作:

1。 按住 Alt + F11鍵 在Excel中的鍵,它打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊,並將以下VBA代碼粘貼到模塊窗口中。

VBA代碼:基於Excel中的列表將文件從一個文件夾移動到另一個文件夾

Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = " Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            Kill xSPathStr & xVal
        End If
    Next
End Sub

3。 然後按 F5 鍵運行此代碼,並彈出提示框提醒您選擇包含文件名的單元格,請參閱屏幕截圖:

4。 然後點擊 OK 按鈕,在彈出的窗口中,請選擇包含您想要移動的文件的文件夾,請參閱屏幕截圖:

5。 然後點擊 OK,繼續選擇您想要在另一個彈出窗口中查找文件的目標文件夾,請參閱屏幕截圖:

6。 最後點擊 OK 關閉窗口,現在,這些文件已被移動到您根據工作表列表中的文件名稱指定的另一個文件夾中,請參閱截圖:

備註:如果您只想將文件複製到另一個文件夾,但保留原始文件,請應用下面的VBA代碼:

VBA代碼:基於Excel中的列表將文件從一個文件夾複製到另一個文件夾

Sub copyfiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub

Kutools for Excel解決了您的大多數問題,並使您的生產率提高了80%

  • 重用: 快速插入 複雜的公式,圖表 以及你以前用過的任何東西; 加密單元格 密碼; 創建郵件列表 並發送電子郵件...
  • 超級方程式酒吧 (輕鬆編輯多行文字和公式); 閱讀佈局 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不丟失數據; 分裂細胞含量; 組合重複的行/列...防止重複的細胞; 比較範圍...
  • 選擇複製或唯一 行; 選擇空行 (所有細胞都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇......
  • 精確複製 多個單元格而不更改公式參考; 自動創建參考 多張表; 插入項目符號,複選框等等......
  • 提取文本,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級過濾器 (將過濾方案保存並應用到其他工作表); 高級排序 按月/週/日,頻率等; 特殊過濾器 用粗體,斜體......
  • 結合工作簿和工作表; 根據鍵列合併表; 將數據拆分為多個表格; 批量轉換xls,xlsx和PDF...
  • 超過300強大的功能。 支持Office / Excel 2007-2019和365。 支持所有語言。 在您的企業或組織中輕鬆部署。 全功能30天免費試用。
kte tab 201905

Office選項卡為Office提供選項卡式界面,使您的工作更輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,Publisher,Access,Visio和Project。
  • 在同一窗口的新選項卡中打開並創建多個文檔,而不是在新窗口中。
  • 通過50%提高您的工作效率,每天為您減少數百次鼠標點擊!
官方底部
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Nasr · 2 months ago
    Any update of how to search on folder and subfolders
    • To post as a guest, your comment is unpublished.
      skyyang · 1 months ago
      Hi, Nasr,
      To move files from folder and subfolders based on cell values, please apply the below VBA code:
      Please try, hope it can help you!

      Sub movefiles()
      'Updateby Extendoffice
      Dim xRg As Range, xCell As Range
      Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
      Dim xSPathStr As Variant, xDPathStr As Variant
      Dim xVal As String
      Dim fso As Object, folder1 As Object
      ' On Error Resume Next
      Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
      If xRg Is Nothing Then Exit Sub
      Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
      xSFileDlg.Title = " Please select the original folder:"
      If xSFileDlg.Show <> -1 Then Exit Sub
      xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
      Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
      xDFileDlg.Title = " Please select the destination folder:"
      If xDFileDlg.Show <> -1 Then Exit Sub
      xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
      Call sMoveFiles(xRg, xSPathStr, xDPathStr)
      End Sub

      Sub sMoveFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
      Dim xCell As Range
      Dim xVal As String
      Dim xFolder As Object
      Dim fso As Object
      Dim xF As Object
      Dim xStr As String
      Dim xFS As Object
      Dim xI As Integer
      On Error Resume Next
      If Dir(xDPathStr, vbDirectory) = "" Then
      MkDir (xDPathStr)
      End If
      For xI = 1 To xRg.Count
      Set xCell = xRg.Item(xI)
      xVal = xCell.Value
      If TypeName(xVal) = "String" And Not (xVal = "") Then
      On Error GoTo E1
      If Dir(xSPathStr & xVal, 16) <> Empty Then
      FileCopy xSPathStr & xVal, xDPathStr & xVal
      Kill xSPathStr & xVal
      End If
      End If
      E1:
      Next xI
      On Error Resume Next
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set xFS = fso.GetFolder(xSPathStr)
      For Each xF In xFS.SubFolders
      xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
      Call sMoveFiles(xRg, xF.ShortPath & "\", xStr & "\")
      If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
      And (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Then
      RmDir xStr
      End If
      Next
      End Sub
      • To post as a guest, your comment is unpublished.
        Nasr · 1 months ago
        That's perfect thank you
        but what about if I just wanted to copy files not moving it from subfolders only without the need of creating subfolders in the destination folder
        ie
        source folder X:\\parent
        inside parent is subfolders test1(file A), test2(file B) and test3(file C)
        then destination folder is "Y:\\destination" has all 3 files A, B, C without the subfolders

        Thank you very much
        • To post as a guest, your comment is unpublished.
          Mike · 7 days ago
          Hi Nasr, did you figure out how to do this? I am looking at a similar need at the moment.

          Copying a selection of files from various subfolders to a single folder
          • To post as a guest, your comment is unpublished.
            Nasr · 2 days ago
            Hi Mike
            I kind of did BUT indirectly, so what I did is modify the code to copy the files not move them with the subfolder
            then with CMD file move the file from subfolders to the main folder then delete the empty subfolder
            this is what I did

            Sub Copyfiles()
            'Updateby Extendoffice
            Dim xRg As Range, xCell As Range
            Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
            Dim xSPathStr As Variant, xDPathStr As Variant
            Dim xVal As String
            Dim fso As Object, folder1 As Object
            ' On Error Resume Next
            Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
            If xRg Is Nothing Then Exit Sub
            Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
            xSFileDlg.Title = " Please select the original folder:"
            If xSFileDlg.Show <> -1 Then Exit Sub
            xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
            Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
            xDFileDlg.Title = " Please select the destination folder:"
            If xDFileDlg.Show <> -1 Then Exit Sub
            xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
            Call sCopyFiles(xRg, xSPathStr, xDPathStr)
            End Sub

            Sub sCopyFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
            Dim xCell As Range
            Dim xVal As String
            Dim xFolder As Object
            Dim fso As Object
            Dim xF As Object
            Dim xStr As String
            Dim xFS As Object
            Dim xI As Integer
            On Error Resume Next
            If Dir(xDPathStr, vbDirectory) = "" Then
            MkDir (xDPathStr)
            End If
            For xI = 1 To xRg.Count
            Set xCell = xRg.Item(xI)
            xVal = xCell.Value
            If TypeName(xVal) = "String" And Not (xVal = "") Then
            On Error GoTo E1
            If Dir(xSPathStr & xVal, 16) <> Empty Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            End If
            End If
            E1:
            Next xI
            On Error Resume Next
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set xFS = fso.GetFolder(xSPathStr)
            For Each xF In xFS.SubFolders
            xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
            Call sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\")
            If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
            And (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Then
            RmDir xStr
            End If
            Next
            End Sub



            then copy the following lines to a new notepad then save it as cmd call it whatever

            for /r %%a IN (*.*) do (
            move /y "%%a" "%cd%"
            )
            for /f "delims=" %%d in ('dir /s /b /ad ^| sort /r') do rd "%%d"



            make sure to copy the code as is 4 lines
            hope that help
            • To post as a guest, your comment is unpublished.
              Nasr · 2 days ago
              make sure to put the cmd file in the same folder that you copy the files and subfolders to then double click it
  • To post as a guest, your comment is unpublished.
    ADOLFO · 3 months ago
    buenas noches, alguien sabe que tengo que modificar para que me mueva carpetas y no solo archivos?
  • To post as a guest, your comment is unpublished.
    jonathan · 4 months ago
    thanks so much !
  • To post as a guest, your comment is unpublished.
    Michael · 4 months ago
    Has anyone figured out how to copy files that are located in multiple subfolders of the main directory, and paste into another folder directory? Also does this transfer method only work for folders on the C drive? I am trying to copy files from our directory that includes multiple subfolders where several files are stored located in Microsoft Sharepoint, to a folder on my C drive.

    Any help would be much appreciated!
  • To post as a guest, your comment is unpublished.
    julien · 5 months ago
    hi do you know how to search also on the subfolder ?
  • To post as a guest, your comment is unpublished.
    Technically Specific · 7 months ago
    Works great - thank you! However-->>>Can this be adjusted to use a PARTIAL FILE NAME? If so, can you help show how?
    In other words, if file name on the Excel sheet list of filenames is: OW4234TR_J19031.txt (I'd like it to only look at last 5 chars "19031" which is a Julian Date and move a range of files... (anything with a Julian Date of 19092 thru 19120) into the March folder.. The ultimate over-arching task is to locate any files that have Julian dates for March and put those in the Fiscal March Folder "06-Mar" , April into the April folder "07-Apr" and so on...so Fiscal reconciliations by month can then take place.. TIA for any help anyone can offer to expedite this time consuming hunt and picking process. =-)
  • To post as a guest, your comment is unpublished.
    Fer · 8 months ago
    en el codigo que copia ¿como puedo colorear el nombre de la lista que no encuentre?
  • To post as a guest, your comment is unpublished.
    Johnette · 9 months ago
    I cannot get either version to work in Windows 10.


    Argggg
  • To post as a guest, your comment is unpublished.
    Andy · 1 years ago
    Any tips on how to modify the code to add a wide card? I have an archive of hundreds of PDF files that are 10 digit numbers and revision level (XXXXXXXXXX_REVA). I can export a list of file names very easily from our ERP system, but the list is missing the revision and file extension. Is there a way to add wild cards into the program to ignore everything BUT the 10 digit number?
  • To post as a guest, your comment is unpublished.
    PWD · 1 years ago
    Hello,
    how to make this code copy files from subfolders?
  • To post as a guest, your comment is unpublished.
    Pr · 1 years ago
    Hi Guys,

    How I need to change '' If TypeName(xVal) = "String" And xVal <> "" Then '' to move files based on partial file name.


    Thanks in advance,
    Best regards, P
    • To post as a guest, your comment is unpublished.
      Technically Specific · 7 months ago
      Did you ever find out HOW to use a PARTIAL FILE NAME? I need that as well...
      In other words, if file name on the Excel sheet list is: OW4234TR_J19031.txt (I'd like it to only look at last 5 chars "19031" which is a Julian Date and move a range of files... anything with a Julian Date of 19031 thru 19075..
      • To post as a guest, your comment is unpublished.
        eric · 2 months ago
        I also would require the partial file name vba modification. Did you ever get a response?
  • To post as a guest, your comment is unpublished.
    Sidney · 1 years ago
    Você não tem noção de como me ajudou com esse script... Muito bom!!! Obrigado!!!
  • To post as a guest, your comment is unpublished.
    Robinson · 1 years ago
    Obrigado!!!!
  • To post as a guest, your comment is unpublished.
    Alisson · 1 years ago
    Era exatamente isso que eu precisava!!!

    Muito Obrigado!!!!
  • To post as a guest, your comment is unpublished.
    Raki · 1 years ago
    Hi, In the source folder, I wish to set it as a constant from a cell, for example the path entered in a particular cell, like A1, should be treated as the source folder. How to do this?
  • To post as a guest, your comment is unpublished.
    madhan · 1 years ago
    It is the nice macro.Real helpful for me. but I need some update macro.this used to copy the files from single folder to another folder. we need copy files from folder and subfolder to another folder.