Excel'de bir listede belirtilen dosyaları bir klasörden başka bir klasöre nasıl kopyalayabilir veya taşıyabilirsiniz?
Bilgisayarınızda bir klasördeki dosyaların adlarının bir çalışma sayfasının bir sütununda listesi varsa ve bu listedeki dosyaları orijinal klasörlerinden aşağıdaki ekran görüntüsünde gösterildiği gibi başka bir klasöre taşımak veya kopyalamak istiyorsanız, Excel’de bu işlemi en hızlı nasıl gerçekleştirebilirsiniz?
Excel'de bir liste temel alınarak VBA koduyla dosyaları bir klasörden başka bir klasöre kopyalama veya taşıma
Aşağıdaki VBA kodu, dosya adlarının bir listesine göre dosyaları bir klasörden başka bir klasöre taşımanıza yardımcı olabilir. Lütfen aşağıdaki adımları izleyin:
1. Excel'de Alt + F11 tuşlarına basılı tutun; bu işlem, Microsoft Visual Basic for Applications penceresini açar.
2. Ekle > Modül seçeneğine tıklayın ve aşağıdaki VBA kodunu Modül Penceresine yapıştırın.
VBA kodu: Excel'de bir liste temel alınarak dosyaları bir klasörden başka bir klasöre 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 kodu çalıştırmak için F5 tuşuna basın; dosya adlarını içeren hücreleri seçmenizi isteyen bir uyarı kutusu açılacaktır. Ekran görüntüsüne bakın:
4. Ardından, açılan pencerede taşımak istediğiniz dosyaların bulunduğu Tamam klasörünü seçin ve Tamam düğmesine tıklayın. Ekran görüntüsüne bakın:
5. Ardından, Tamam seçeneğine tıklayarak başka bir açılır pencerede dosyaların yerleştirileceği hedef klasörü seçmeye devam edin. Ekran görüntüsüne bakın:
6. Son olarak, Tamam düğmesine tıklayarak bu pencereyi kapatın ve işlemi tamamlayın. Artık dosyalar, Çalışma Sayfası Listesi’ndeki 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ı korumak istiyorsanız lütfen aşağıdaki VBA kodunu kullanın:
VBA kodu: Excel'de bir liste temel alınarak dosyaları bir klasörden başka bir klasöre 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'in Sihirli Gücünü Açığa Çıkarın
- Akıllı Yürütme: Hücre işlemlerini gerçekleştirin, verileri analiz edin ve hepsi basit komutlarla çalışan grafikler oluşturun.
- Özel formüller: İş akışlarınızı kolaylaştırmak için özelleştirilmiş formüller oluşturun.
- VBA Kodlama: VBA kodlarını zahmetsizce yazın ve uygulayın.
- Formül Yorumlama: Karmaşık formülleri kolayca çözmek artık çok daha basit!
- Metin Çevirisi: Elektronik tablolarınızda dil bariyerlerini aşın.
En İyi Office Üretkenlik Araçları
Excel becerilerinizi Kutools for Excel ile geliştirin ve verimlilikte hiç yaşamadığınız bir deneyim yaşayın.Kutools for Excel, üretkenliği artırmak ve Zamanı Kaydet için 300’den fazla gelişmiş özelliğe sahiptir.İhtiyacınız olan özelliği hemen edinmek için buraya tıklayın…
Office Tab, Office uygulamalarına sekmeli bir arayüz kazandırarak işlerinizi çok daha kolay hale getirir.
- Word, Excel, PowerPoint, Publisher, Access, Visio ve Project'te sekmeli düzenleme ve okuma özelliğini etkinleştirin.
- Belgeleri yeni pencerelerde değil, aynı pencerenin yeni sekmelerinde açıp oluşturun.
- Günlük üretkenliğinizi %50 artırır ve her gün yüzlerce fare tıklamasından tasarruf etmenizi sağlar!
Tüm Kutools eklentileri — tek bir kurulum dosyasında!
Kutools for Office paketi, Excel, Word, Outlook ve PowerPoint eklentilerini ve ayrıca Office Tab Pro’yu içeren kapsamlı bir çözümdür; Office uygulamalarında çalışan ekipler için idealdir.
- Hepsi bir arada paket— Excel, Word, Outlook ve PowerPoint eklentileri + Office Tab Pro
- Tek kurulum, tek lisans— birkaç dakikada hazır (MSI uyumlu)
- Birlikte daha iyi çalışır— Office uygulamalarında akıcı üretkenlik
- 30 günlük tam özellikli deneme— kayıt gerekmez, kredi kartı gerekmez
- En iyi fiyat performans— ayrı ayrı eklenti satın almaya göre tasarruf sağlar