İpucu: Digər dillər Google-tərcümə olunur. Sizi ziyarət edə bilərsiniz English bu linkin versiyası.
Daxil ol
x
or
x
x
Qeydiyyatdan
x

or

Excel-də siyahıya əsaslanan faylları bir qovluqdan digərinə kopyalamaq və ya daşımaq necə?

Bir iş yerindəki bir sütunda fayl adları siyahısına sahibiyseniz və faylları bilgisayarınızdakı bir qovluqda tapsanız. Lakin, indi, göstərilən ekran görüntüsü kimi adları, orijinal qovluğundan başqa birinə iş siyahısına verilmiş olan faylları köçürməlisiniz və ya surətləyin. Excel-də olduğu kimi bu işi necə tez başa edə bilərsən?

VBA kodu ilə Excel-də siyahıya əsaslanan faylları qovluqdan başqa birinə köçürün və ya daşıyın


VBA kodu ilə Excel-də siyahıya əsaslanan faylları qovluqdan başqa birinə köçürün və ya daşıyın


Faylların adları siyahısına əsasən faylları bir qovluqdan digərinə daşımaq üçün aşağıdakı VBA kodu bir xeyir verə bilər, xahiş edirəm:

1. Basıb saxlayın Alt + F11 Excel açarları və açar Proqramlar üçün Microsoft Visual Basic pəncərə.

2. Basın Taxmaq > Modulesvə Modul Pəncərəsində aşağıdakı VBA kodunu yapışdırın.

VBA kodu: Excel-də bir siyahıya əsaslanan faylları bir qovluqdan digərinə daşıyın

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. Və sonra basın F5 bu kodu çalıştırmak üçün düyməsini basın və bir faylın adlarını ehtiva hüceyrələri seçməyi xatırlatmaq üçün bir əmr qutusu açılır, ekran görünüşünə baxın:

4. Sonra basın OK düyməsini basın və açılan pəncərədə, hərəkət etmək istədiyiniz faylları olan qovluğu seçin, ekran görünüşünə baxın:

5. Və sonra basın OK, başqa bir açılan pəncərədə faylları tapmaq istədiyiniz hədəf qovluğunun seçilməsinə davam edin, ekran görünüşünə baxın:

6. Nəhayət, vurun OK pəncərəni bağlamaq üçün və indi fayllar, iş səhifələr siyahısında fayl adlarına əsaslanaraq göstərdiyiniz başqa bir qovluğa köçürülüb, ekran görünüşünə baxın:

QeydYalnız faylları başqa bir qovluğa kopyalamaq istəyirsinizsə, lakin orijinal faylları saxlamağınız halında, aşağıdakı VBA kodunu tətbiq edin:

VBA kodu: Excel-də bir siyahıya əsaslanan faylları bir qovluqdan digərinə kopyalayın

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


Təklif olunan Məhsuldarlıq Vasitələri

Office Tab

qızıl star1 Chrome, Firefox və yeni Internet Explorer kimi Excel və digər Office proqramlarına lazımlı sekmeleri gətirin.

Excel üçün Kutools

qızıl star1 Amazing! 5 dəqiqədə məhsuldarlığınızı artırın. Heç bir xüsusi bacarıqa ehtiyac yoxdur, hər gün iki saat saxlaya bilərsiniz!

qızıl star1 300 Excel üçün yeni funksiyalar, Excel çox asan və güclü olun:

  • Veriyi ləğv etmədən Cell / Satır / Sütunları birləşdirin.
  • Bir neçə Çarşaf və İş Kitabını birləşdirin və birləşdirin.
  • Çaprazları müqayisə edin, birdən çox aralığa kopyalayın, mətni tarixə, vahidə və valyuta çevrilməsinə çevirin.
  • Rənglər, Paging Subtotals, Advanced Sort və Super Filter tərəfindən sayılan,
  • Daha çox seçin / Insert / Sil / Mətn / Biçim / Bağlantı / Yorum / Çalışma kitabları / Çalışma Qurğuları Tools ...

Excel üçün Kutools-un ekranı

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.
    Fer · 24 days 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 · 1 months ago
    I cannot get either version to work in Windows 10.


    Argggg
  • To post as a guest, your comment is unpublished.
    Andy · 4 months 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 · 5 months ago
    Hello,
    how to make this code copy files from subfolders?
  • To post as a guest, your comment is unpublished.
    Pr · 6 months 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