Note: The other languages of the website are Google-translated. Back to English

Hoe bestanden van de ene map naar de andere te kopiëren of te verplaatsen op basis van een lijst in Excel? 

Als u een lijst met bestandsnamen in een kolom in een werkblad heeft en de bestanden zich in een map op uw computer bevinden. Maar nu moet u deze bestanden verplaatsen of kopiëren waarvan de namen in het werkblad worden vermeld van hun oorspronkelijke map naar een andere zoals in het volgende screenshot. Hoe kon je deze taak zo snel mogelijk voltooien in Excel?

Kopieer of verplaats bestanden van de ene map naar de andere op basis van een lijst in Excel met VBA-code


Kopieer of verplaats bestanden van de ene map naar de andere op basis van een lijst in Excel met VBA-code

Om de bestanden van de ene map naar de andere te verplaatsen op basis van een lijst met bestandsnamen, kan de volgende VBA-code u een plezier doen, doe dit als volgt:

1. Houd de Alt + F11 toetsen in Excel, en het opent het Microsoft Visual Basic voor toepassingen venster.

2. Klikken Invoegen > Moduleen plak de volgende VBA-code in het modulevenster.

VBA-code: verplaats bestanden van de ene map naar de andere op basis van een lijst in 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. En druk vervolgens op F5 sleutel om deze code uit te voeren, en er verschijnt een promptvenster om u eraan te herinneren de cellen te selecteren die de bestandsnamen bevatten, zie screenshot:

4. Dan klikken OK knop, en selecteer in het uitgeklapte venster de map die de bestanden bevat waaruit u wilt verplaatsen, zie screenshot:

5. En klik vervolgens op OK, ga door met het selecteren van de bestemmingsmap waar u de bestanden wilt lokaliseren in een ander uitgeklapt venster, zie screenshot:

6. Klik ten slotte op OK om het venster te sluiten, en nu zijn de bestanden verplaatst naar een andere map die u hebt opgegeven op basis van de bestandsnamen in de werkbladlijst, zie screenshot:

Opmerking:: Als u de bestanden alleen naar een andere map wilt kopiëren, maar de originele bestanden wilt behouden, past u de onderstaande VBA-code toe:

VBA-code: kopieer bestanden van de ene map naar de andere op basis van een lijst in 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

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert elke dag honderden muisklikken!
officetab onderkant
Comments (55)
Nog geen beoordelingen. Beoordeel als eerste!
Deze opmerking is gemaakt door de moderator op de site
Het is de mooie macro. Echt nuttig voor mij. maar ik heb een update-macro nodig. Dit wordt gebruikt om de bestanden van een enkele map naar een andere map te kopiëren. we moeten bestanden kopiëren van map en submap naar een andere map.
Deze opmerking is gemaakt door de moderator op de site
Hallo, In de bronmap wil ik het als een constante van een cel instellen, bijvoorbeeld het pad dat in een bepaalde cel is ingevoerd, zoals A1, moet worden behandeld als de bronmap. Hoe doe je dit?
Deze opmerking is gemaakt door de moderator op de site
Era exatamente isso que eu precisava!!!

Muito Obrigado!!!!
Deze opmerking is gemaakt door de moderator op de site
Bedankt!!!!
Deze opmerking is gemaakt door de moderator op de site
Você não tom noção como me ajudou com esse script... Muito bom!!! Obrigado!!!
Deze opmerking is gemaakt door de moderator op de site
Hi Guys,

Hoe moet ik '' If TypeName(xVal) = "String" And xVal <> "" Then '' wijzigen om bestanden te verplaatsen op basis van een gedeeltelijke bestandsnaam.


Bij voorbaat dank,
Met vriendelijke groet, P
Deze opmerking is gemaakt door de moderator op de site
Ben je er ooit achter gekomen HOE je een GEDEELTELIJKE BESTANDSNAAM moet gebruiken? dat heb ik ook nodig...
Met andere woorden, als de bestandsnaam in de Excel-bladlijst is: OW4234TR_J19031.txt (ik zou graag zien dat het alleen naar de laatste 5 tekens "19031" kijkt, wat een Juliaanse datum is en een reeks bestanden verplaatst ... alles met een Juliaanse datum van 19031 tot 19075..
Deze opmerking is gemaakt door de moderator op de site
Ik zou ook de gedeeltelijke bestandsnaam vba-wijziging nodig hebben. Heb je ooit een reactie gekregen?
Deze opmerking is gemaakt door de moderator op de site
Ik ben geïnteresseerd in precies dezelfde oplossing! Heeft iemand het antwoord gekregen? Ik heb een P/N-lijst in een kolom en ik wil een stukje code dat in een bovenliggende map kijkt die verschillende submappen heeft na bestanden met de naam die door de lijst wordt aangegeven, maar slechts gedeeltelijk, omdat ik ik ken de bestandsextensie niet en in veel gevallen heb ik voor een enkele P/N in de lijst verschillende bestanden die worden onderscheiden door het bestaan ​​van een achtervoegsel dat niet altijd hetzelfde patroon heeft, zoals xxxx_1, xxxx_2, xxx (1 ), xxxx [1], xxxx- (a ), xxxx_ (b) ...., maar ik moet alle exemplaren van de bestanden die in hun naam de P/N bevatten, in de doelmap kopiëren. Help mij om dit werk niet handmatig te doen voor 34078 bestanden die vandaag in de bovenliggende map en submappen worden gevonden
Deze opmerking is gemaakt door de moderator op de site
Hallo,
hoe deze code bestanden uit submappen te laten kopiëren?
Deze opmerking is gemaakt door de moderator op de site
Tips voor het wijzigen van de code om een ​​brede kaart toe te voegen? Ik heb een archief van honderden PDF-bestanden met 10-cijferige nummers en revisieniveau (XXXXXXXXXX_REVA). Ik kan heel gemakkelijk een lijst met bestandsnamen exporteren vanuit ons ERP-systeem, maar de lijst mist de revisie en bestandsextensie. Is er een manier om jokertekens aan het programma toe te voegen om alles te negeren, MAAR het 10-cijferige nummer?
Deze opmerking is gemaakt door de moderator op de site
Ik krijg geen van beide versies werkend in Windows 10.


Argggg
Deze opmerking is gemaakt door de moderator op de site
en el codigo que copia ¿como puedo colorear el nombre de la lista que no encuentre?
Deze opmerking is gemaakt door de moderator op de site
Werkt uitstekend - bedankt! Maar-->>>Kan dit worden aangepast om een ​​GEDEELTELIJKE BESTANDSNAAM te gebruiken? Zo ja, kunt u laten zien hoe?
Met andere woorden, als de bestandsnaam in de Excel-lijst met bestandsnamen is: OW4234TR_J19031.txt (ik zou graag zien dat het alleen naar de laatste 5 tekens "19031" kijkt, wat een Juliaanse datum is en een reeks bestanden verplaatst... ( alles met een Juliaanse datum van 19092 tot en met 19120) in de maart-map. De ultieme overkoepelende taak is om alle bestanden met Juliaanse datums voor maart te lokaliseren en die in de Fiscale maart-map "06-Mar", april in de Map van april "07-apr" enzovoort ... zodat fiscale afstemmingen per maand kunnen plaatsvinden. TIA voor alle hulp die iemand kan bieden om dit tijdrovende jacht- en pickproces te versnellen. =-)
Deze opmerking is gemaakt door de moderator op de site
hallo, weet je hoe je ook in de submap kunt zoeken?
Deze opmerking is gemaakt door de moderator op de site
Heeft iemand ontdekt hoe je bestanden kopieert die zich in meerdere submappen van de hoofdmap bevinden en in een andere mapmap plakken? Werkt deze overdrachtsmethode ook alleen voor mappen op de C-schijf? Ik probeer bestanden te kopiëren van onze map die meerdere submappen bevat waarin verschillende bestanden zijn opgeslagen in Microsoft Sharepoint, naar een map op mijn C-schijf.

Alle hulp zou zeer op prijs gesteld worden!
Deze opmerking is gemaakt door de moderator op de site
heel erg bedankt !
Deze opmerking is gemaakt door de moderator op de site
buenas noches, alguien sabe que tengo que modificar para que me mueva carpetas y no solo archivos?
Deze opmerking is gemaakt door de moderator op de site
Elke update van hoe te zoeken in mappen en submappen
Deze opmerking is gemaakt door de moderator op de site
Hallo, Nasr,
Om bestanden uit de map en submappen te verplaatsen op basis van celwaarden, past u de onderstaande VBA-code toe:
Probeer het alsjeblieft, ik hoop dat het je kan helpen!

Subverplaatsingsbestanden()
'Bijwerken door' Extendoffice
Dim xRg als bereik, xCell als bereik
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr als variant, xDPathStr als variant
Dim xVal As String
Dim fso als object, map1 als object
' Bij fout Hervatten volgende
Set xRg = Application.InputBox("Selecteer de bestandsnamen:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Als xRg niets is, sluit dan Sub af
Stel xSFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in
xSFileDlg.Title = " Selecteer de originele map:"
Als xSFileDlg.Show <> -1 Sub afsluiten
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Stel xDFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in
xDFileDlg.Title = " Selecteer de doelmap:"
Als xDFileDlg.Show <> -1 Subsub afsluiten
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Roep sMoveFiles(xRg, xSPathStr, xDPathStr) aan
End Sub

Sub sMoveFiles (xRg als bereik, xSPathStr als variant, xDPathStr als variant)
Dim xCell als bereik
Dim xVal As String
Dim xFolder als object
Dim fso als object
Dim xF als object
Dim xStr As String
Dim xFS als object
Dim xI als geheel getal
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Dan
MkDir (xDPathStr)
End If
Voor xI = 1 Tot xRg.Count
Stel xCell = xRg.Item (xI) in
xWaarde = xCel.Waarde
If TypeName(xVal) = "String" en niet (xVal = "") Dan
Bij fout Ga naar E1
Als Dir(xSPathStr & xVal, 16) <> Leeg Dan
Bestandskopie xSPathStr & xVal, xDPathStr & xVal
Dood xSPathStr & xVal
End If
End If
E1:
Volgende xI
On Error Resume Next
Stel fso = CreateObject ("Scripting.FileSystemObject")
Stel xFS = fso.GetFolder(xSPathStr) in
Voor elke xF in xFS.Submappen
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Roep sMoveFiles(xRg, xF.ShortPath & "\", xStr & "\") aan
If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
En (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Dan
RmDir xStr
End If
Volgende
End Sub
Deze opmerking is gemaakt door de moderator op de site
Dat is perfect bedankt
maar hoe zit het als ik alleen bestanden wil kopiëren en deze niet alleen uit submappen wil verplaatsen zonder dat ik submappen in de doelmap hoef te maken
ie
bronmap X:\\parent
binnen ouder zijn submappen test1(bestand A), test2(bestand B) en test3(bestand C)
dan is de bestemmingsmap "Y:\\destination" heeft alle 3 bestanden A, B, C zonder de submappen

Heel erg bedankt
Deze opmerking is gemaakt door de moderator op de site
Hallo Nasr, heb je ontdekt hoe je dit moet doen? Ik kijk op dit moment naar een vergelijkbare behoefte.

Een selectie van bestanden kopiëren uit verschillende submappen naar een enkele map
Deze opmerking is gemaakt door de moderator op de site
Hoi Mike
Ik deed het min of meer MAAR indirect, dus wat ik deed, was de code wijzigen om de bestanden te kopiëren en ze niet met de submap te verplaatsen
verplaats vervolgens met CMD-bestand het bestand van submappen naar de hoofdmap en verwijder vervolgens de lege submap
dit is wat ik deed

Subkopiebestanden()
'Bijwerken door' Extendoffice
Dim xRg als bereik, xCell als bereik
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr als variant, xDPathStr als variant
Dim xVal As String
Dim fso als object, map1 als object
' Bij fout Hervatten volgende
Set xRg = Application.InputBox("Selecteer de bestandsnamen:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Als xRg niets is, sluit dan Sub af
Stel xSFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in
xSFileDlg.Title = " Selecteer de originele map:"
Als xSFileDlg.Show <> -1 Sub afsluiten
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Stel xDFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in
xDFileDlg.Title = " Selecteer de doelmap:"
Als xDFileDlg.Show <> -1 Subsub afsluiten
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Roep sCopyFiles(xRg, xSPathStr, xDPathStr) aan
End Sub

Sub sCopyFiles (xRg als bereik, xSPathStr als variant, xDPathStr als variant)
Dim xCell als bereik
Dim xVal As String
Dim xFolder als object
Dim fso als object
Dim xF als object
Dim xStr As String
Dim xFS als object
Dim xI als geheel getal
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Dan
MkDir (xDPathStr)
End If
Voor xI = 1 Tot xRg.Count
Stel xCell = xRg.Item (xI) in
xWaarde = xCel.Waarde
If TypeName(xVal) = "String" en niet (xVal = "") Dan
Bij fout Ga naar E1
Als Dir(xSPathStr & xVal, 16) <> Leeg Dan
Bestandskopie xSPathStr & xVal, xDPathStr & xVal
End If
End If
E1:
Volgende xI
On Error Resume Next
Stel fso = CreateObject ("Scripting.FileSystemObject")
Stel xFS = fso.GetFolder(xSPathStr) in
Voor elke xF in xFS.Submappen
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Roep sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\") aan
If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
En (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Dan
RmDir xStr
End If
Volgende
End Sub



kopieer vervolgens de volgende regels naar een nieuw kladblok en sla het op als cmd noem het wat dan ook

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



zorg ervoor dat u de code kopieert zoals deze is 4 regels
hoop dat dat helpt
Deze opmerking is gemaakt door de moderator op de site
zorg ervoor dat u het cmd-bestand in dezelfde map plaatst als waarin u de bestanden en submappen kopieert en dubbelklik erop
Deze opmerking is gemaakt door de moderator op de site
U kunt hetzelfde resultaat bereiken met alleen de VBA als u een ' toevoegt voor de & "\" & xF.Name in de onderstaande regel.
Dit kopieert nog steeds uit submappen, maar kopieert naar een map met één niveau.

xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Wordt
xStr = xDPathStr '& "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Deze opmerking is gemaakt door de moderator op de site
Hallo skyyang, ik wil bestanden (.jpg, .png) in elk formaat uit de map en de submappen kopiëren of verplaatsen. Het bovenstaande script kopieert de hele map met het overeenkomende bestand
Bedankt & groeten,
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik ben geen expert in VBA, maar heb je module nodig en ik deed wat je instrueerde, maar niets gekopieerd van de bronmap naar de nieuwe map. en er wordt geen fout getoond
Deze opmerking is gemaakt door de moderator op de site
Wat gebeurt er als het bestand niet bestaat in de oorspronkelijke map?
de code breekt

De code moet een regel hebben om naar een andere referentie te springen als deze niet bestaat
Deze opmerking is gemaakt door de moderator op de site
Als de referentie niet bestaat, breekt de code
welke regel moet ik hebben om de code zonder stop door de volgende referentie te laten springen?
Deze opmerking is gemaakt door de moderator op de site
Hoe kan dit worden aangepast om in een lijst met meerdere bestandspaden te plakken in plaats van één pad tegelijk?
Deze opmerking is gemaakt door de moderator op de site
Hallo, sabijn,
Wilt u de bestanden kopiëren en plakken die afkomstig zijn uit meerdere originele mappen in plaats van slechts één map?
Deze opmerking is gemaakt door de moderator op de site
Ja graag
Er zijn nog geen reacties geplaatst
Laad meer
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0  Personages
Voorgestelde locaties