Excel'deki bir listeye göre dosyaları bir klasörden diğerine nasıl kopyalayabilir veya taşıyabilirsiniz? 

Bir çalışma sayfasındaki bir sütunda dosya adlarının listesi varsa ve bu dosyalar bilgisayarınızda bir klasörde bulunuyorsa. Ancak şimdi, aşağıdaki ekran görüntüsünde gösterildiği gibi, bu dosyaları orijinal klasörlerinden başka bir klasöre taşımak veya kopyalamak istiyorsunuz. Bu görevi Excel'de mümkün olduğunca hızlı bir şekilde nasıl tamamlayabilirsiniz?

VBA kodu ile Excel'deki bir listeye göre dosyaları bir klasörden diğerine kopyalama veya taşıma

VBA kodu ile Excel'deki bir listeye göre dosyaları bir klasörden diğerine kopyalama veya taşıma

Dosya isimlerinin bir listesine dayanarak dosyaları bir klasörden diğerine taşımak için aşağıdaki VBA kodu size yardımcı olabilir, lütfen şu adımları izleyin:

1. Excel'de Alt + F11 tuşlarına basın, bu Microsoft Visual Basic for Applications penceresini açar.

2. Ekle Insert > Module'e tıklayın ve aşağıdaki VBA kodunu Modül Penceresine yapıştırın.

VBA Kodu: Excel'deki bir listeye göre dosyaları bir klasörden diğerine taşıma

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. Ardından bu kodu çalıştırmak için F5 tuşuna basın ve ekrana, dosya adlarını içeren hücreleri seçmenizi hatırlatan bir uyarı kutusu çıkacak, aşağıdaki ekran görüntüsüne bakın:

4. Tamam butonuna tıklayın ve açılan pencerede, taşımak istediğiniz dosyaları içeren klasörü seçin, aşağıdaki ekran görüntüsüne bakın:

5. Ardından Tamam'a tıklayın, devam edin ve dosyaları yerleştirmek istediğiniz hedef klasörü başka bir açılan pencerede seçin, aşağıdaki ekran görüntüsüne bakın:

6. Son olarak, pencereyi kapatmak için Tamam'a tıklayın ve artık dosyalar, çalışma sayfası listesindeki dosya adlarına göre belirttiğiniz başka bir klasöre taşınmış olacaktır, aşağıdaki ekran görüntüsüne bakın:

Not: Eğer dosyaları sadece başka bir klasöre kopyalamak istiyorsanız ancak orijinal dosyaları korumak istiyorsanız, lütfen aşağıdaki VBA kodunu uygulayın:

VBA Kodu: Excel'deki bir listeye göre dosyaları bir klasörden diğerine kopyalama

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 AI ile Excel Sihirini Keşfedin

• Akıllı Yürütme: Hücre işlemleri gerçekleştirin, verileri analiz edin ve grafikler oluşturun—tümü basit komutlarla sürülür.
• Özel Formüller: İş akışlarınızı hızlandırmak için özel formüller oluşturun.
• VBA Kodlama: VBA kodunu kolayca yazın ve uygulayın.
• Formül Yorumlama: Karmaşık formülleri kolayca anlayın.
• Metin Çevirisi: Elektronik tablolarınız içindeki dil engellerini aşın.

Yapay zeka destekli araçlarla Excel yeteneklerinizi geliştirin. Şimdi İndirin ve daha önce hiç olmadığı gibi bir verimlilik deneyimi yaşayın!