Klasörden Veri Kopyalama

[metin_0606]

Aşagıdaki makro ile çalışma sayfamın A sütununa yazdığım TC kimlik numaraları doğrultusunda bir klasörden başka bir klasöre veri kopyalamaktayım. Mevcut makroda veri alınacak klasör sayısını nasıl çoğaltabili

Sub KOPYALA_SGK()

    Dim A As Object, dsy As String
    Dim Klas1 As String
    Dim Klas2 As String
    Klas1 = "C:\SGK\" 'VERİ ALINACAK KLASÖR
    Klas2 = "C:\KLASOR1\" 'VERİ TAŞINACAK KLASÖR
    Set A = CreateObject("scripting.filesystemobject")
If Not A.FolderExists(Klas2) Then MkDir Klas2
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Trim(Cells(i, "A").Value) <> "" Then
dsy = Dir(Klas1 & Trim(Cells(i, "A").Value) & "*.*", vbDirectory)
If A.FileExists(Klas1 & dsy) = True Then
A.copyFile Source:=Klas1 & dsy, Destination:=Klas2 & "\"
Cells(i, "A").Interior.ColorIndex = 4
Else
Cells(i, "A").Interior.ColorIndex = 3
End If: End If
Next
MsgBox "işlem tamam"
End Sub

rim.

 

[metin_0606]

Guncel

 

[metin_0606]

@ Korhan Ayhan hocam yazmış olduğunuz bu makroda revize yapabilirmiyiz

 

[metin_0606]

Güncel