Cum să copiați sau să mutați fișiere dintr-un dosar în altul pe baza unei liste din Excel? 

Dacă aveți o listă de nume de fișiere într-o coloană dintr-o foaie de lucru, iar fișierele se găsesc într-un folder din calculatorul dvs. Dar, acum, trebuie să mutați sau să copiați aceste fișiere ale căror nume sunt listate în foaia de lucru din folderul original în altul, după cum se arată în următoarea captură de ecran. Cum ați putea termina această sarcină cât de repede puteți în Excel?

Copiați sau mutați fișiere dintr-un dosar în altul pe baza unei liste în Excel cu cod VBA

Copiați sau mutați fișiere dintr-un dosar în altul pe baza unei liste în Excel cu cod VBA

Pentru a muta fișierele dintr-un dosar în altul pe baza unei liste de nume de fișiere, următorul cod VBA vă poate face o favoare, vă rugăm să procedați astfel:

1. Țineți apăsat butonul Alt + F11 tastele în Excel și deschide fișierul Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următorul cod VBA în fereastra modulului.

Cod VBA: Mutați fișierele dintr-un dosar în altul pe baza unei liste din 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. Și apoi apăsați F5 pentru a rula acest cod și va apărea o casetă de solicitare pentru a vă reaminti să selectați celulele care conțin numele fișierelor, a se vedea captura de ecran:

4. Apoi apasa OK și, în fereastra pop-out, selectați folderul care conține fișierele din care doriți să vă mutați, vedeți captura de ecran:

5. Apoi faceți clic pe OK, continuați să selectați folderul de destinație unde doriți să localizați fișierele într-o altă fereastră ieșită, vedeți captura de ecran:

6. În cele din urmă, faceți clic pe OK pentru a închide fereastra și acum, fișierele au fost mutate într-un alt folder pe care l-ați specificat pe baza numelor de fișiere din lista foilor de lucru, consultați captura de ecran:

notițe: Dacă doriți doar să copiați fișierele într-un alt folder, dar păstrați fișierele originale, vă rugăm să aplicați codul VBA de mai jos:

Cod VBA: copiați fișierele dintr-un folder în altul pe baza unei liste din 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

Deblocați Excel Magic cu Kutools AI

• Execuție inteligentă: Efectuați operații cu celule, analizați date și creați diagrame, toate conduse de comenzi simple.
• Formule personalizate: generați formule personalizate pentru a vă simplifica fluxurile de lucru.
• Codare VBA: Scrieți și implementați codul VBA fără efort.
• Interpretarea formulei: Înțelegeți cu ușurință formulele complexe.
• Traducere text: spargeți barierele lingvistice din foile de calcul.

Îmbunătățiți-vă capabilitățile Excel cu instrumente bazate pe inteligență artificială. Descarcă acum și experimentați eficiența ca niciodată!