Excel'deki bir listeye göre dosyaları bir klasörden diğerine nasıl kopyalayabilirim veya taşıyabilirim?
Bir çalışma sayfasındaki bir sütunda dosya adları listeniz varsa ve dosyalar bilgisayarınızdaki bir klasörde bulunuyorsa. Ancak, şimdi, çalışma sayfasında listelenen bu dosyaları, aşağıdaki ekran görüntüsü gibi orijinal klasörlerinden başka bir klasöre taşımanız veya kopyalamanız gerekir. Bu görevi Excel'de yapabildiğiniz kadar çabuk nasıl bitirebilirsiniz?
VBA kodu ile Excel'deki bir listeye göre dosyaları bir klasörden diğerine kopyalayın veya taşıyın
VBA kodu ile Excel'deki bir listeye göre dosyaları bir klasörden diğerine kopyalayın veya taşıyın
Dosyaları bir klasörden diğerine dosya adları listesine göre taşımak için aşağıdaki VBA kodu size bir iyilik yapabilir, lütfen şu şekilde yapın:
1. Basılı tutun Alt + F11 Excel'de anahtarlar ve açılır Uygulamalar için Microsoft Visual Basic pencere.
2. tıklayın Ekle > modülve aşağıdaki VBA kodunu Modül Penceresine yapıştırın.
VBA kodu: Dosyaları Excel'deki bir listeye göre bir klasörden diğerine taşı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. Ve sonra tuşuna basın. F5 Bu kodu çalıştırmak için bir anahtar ve dosya adlarını içeren hücreleri seçmenizi hatırlatmak için bir komut kutusu açılır, ekran görüntüsüne bakın:
4. Sonra tıklayın OK düğmesi ve açılan pencerede, lütfen taşımak istediğiniz dosyaları içeren klasörü seçin, ekran görüntüsüne bakın:
5. Ve sonra tıklayın OK, dosyaları başka bir açılır pencerede bulmak istediğiniz hedef klasörü seçmeye devam edin, ekran görüntüsüne bakın:
6. Son olarak, OK pencereyi kapatmak için ve şimdi dosyalar, çalışma sayfası listesindeki dosya adlarına göre belirttiğiniz başka bir klasöre taşındı, ekran görüntüsüne bakın:
not: Dosyaları başka bir klasöre kopyalamak, ancak orijinal dosyaları saklamak istiyorsanız, lütfen aşağıdaki VBA kodunu uygulayın:
VBA kodu: Dosyaları Excel'deki bir listeye göre bir klasörden diğerine 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
En İyi Ofis Üretkenlik Araçları
Kutools for Excel ile Excel Becerilerinizi Güçlendirin ve Daha Önce Hiç Olmadığı Gibi Verimliliği Deneyimleyin. Kutools for Excel, Üretkenliği Artırmak ve Zamandan Tasarruf Etmek için 300'den Fazla Gelişmiş Özellik Sunar. En Çok İhtiyacınız Olan Özelliği Almak İçin Buraya Tıklayın...
Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir
- Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
- Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
- Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!