Çözüldü Bir klasörden birden fazla klasöre dosya kopyalama

Katılım
20 Aralık 2023
Mesajlar
23
Excel Vers. ve Dili
2015 turkish
Merhabalar,

A sütünuna kaynak klasöründen çekeceğim dosya isimlerini yazacağım ve bunları B sütünundaki dosya uzantıları olan farklı klasörlere kopyalamak istiyorum.
Bununla ilgili yardımlarınızı rica ediyorum ,Teşekkürler
Kopyalanacak dosya formatı " .pdf "
 
Katılım
20 Aralık 2023
Mesajlar
23
Excel Vers. ve Dili
2015 turkish
Hepsini daha öncesinden bakmıştım ama benim aradığım gibi birşey yok.
A sütununda yazan kaynak klasöründen kopyalayıp b sütununda belirteceğim dosya yollarına yapıştırmak istiyorum.
Yani kaynak klasör bir tane ama hedef klasör birden fazla olacak şekilde bir macro arıyorum
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
A ve B sütununda listeler hazır mı? Örnek dosya paylaşabilirmisiniz.
 
Katılım
20 Aralık 2023
Mesajlar
23
Excel Vers. ve Dili
2015 turkish

Korhan hocam dosyayı linke koydum. A sütununda bulunan pdf dosyaları benim kaynak klasörümde o isimde mevcut ben bunları b sütununda bulunan farklı farklı hedef klasörlerine kopyalamak istiyorum
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Source_File_Path bölümüne A sütunundaki PDF dosyalarınızın bulunduğu klasörün yolunu yazınız.

C++:
Option Explicit

Sub Copy_PDF_File()
    Dim Rng As Range, My_File As String
    Dim Source_File_Path As String
    Dim File_Count As Long
   
    Source_File_Path = "C:\Users\Admin\Desktop\Test_1\"
   
    For Each Rng In Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
        If Len(Rng.Value) > 0 And Len(Rng.Offset(, 1).Value) > 0 Then
            My_File = Source_File_Path & Rng.Value & ".pdf"
            If Dir(My_File) <> "" Then
                With VBA.CreateObject("Scripting.FileSystemObject")
                    .CopyFile My_File, Rng.Offset(, 1).Value & Application.PathSeparator
                End With
                File_Count = File_Count + 1
            Else
                Rng.Interior.ColorIndex = 3
            End If
        End If
    Next

    MsgBox Format(File_Count, "#,##0") & " adet dosya başarıyla kopyalandı!"
End Sub
 
Katılım
20 Aralık 2023
Mesajlar
23
Excel Vers. ve Dili
2015 turkish
Korhan hocam işe yaradı çalışıyor eline koluna sağlık çok teşekkür ederim çok minnettarım :)
 
Katılım
20 Aralık 2023
Mesajlar
23
Excel Vers. ve Dili
2015 turkish
Hocam bu çok işe yarıyor kullanıyorumda ama kopyalama bittikten sonra kaç adet kopyalandığı mesajı alıyorum ama listedekilerin hangilerinin kopyalanmadığını bilemiyorum kopyalanamayan satırlar kırmızı yapabilirmisiniz ?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Koda küçük bir ekleme yaptım. Tekrar deneyiniz.
 
Katılım
20 Aralık 2023
Mesajlar
23
Excel Vers. ve Dili
2015 turkish
Hocam Allah razı olsun çok sağolun. Hocam bu sistemin aynısını sadece klasör içinde ayarlıyabilirmiyiz ? Yani bu kodla 1018 tane pdf'yi 268 adet klasöre kopyaladım ve şimdi o 268 adet klasörü 32 adet klasörün içine atmam gerekiyor bunu bu şekilde yapabilirmisiniz lütfen ?
 
Üst