Dosya klasöre taşıma

[igultekin2000]

iyi günler;
Klasörün içinde, klasörler var ve içlerinde Pdf dosyalar var. Kullandığım makro ile "Beyanname" klasörünün içinde oluşturduğum "topla" klasörünü klasörlerine "PDF" dosyaların topluyorum. Makro çalıştırdığımızda verilerin toplanacağı yeni bir klasör oluşturup da oraya PDF dosyaların toplasa daha pratik olacak. Teşekkürler.

Sub tasi()
Set ds = CreateObject("Scripting.FileSystemObject")
anayol = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\Beyanname"
yol = anayol
Columns(1).Clear
Application.ScreenUpdating = False
Do
Tekrar:
If ds.GetFolder(yol).subfolders.Count > 0 Then
    For Each kls In ds.GetFolder(yol).subfolders
        If kls <> anayol & "\topla" Then klslst = klslst & "{" & kls
    Next
End If
x = x + 1
deg = Split(klslst, "{")
yol = deg(x)
Dosya = Dir$(yol & "\*.*")
Do While Dosya <> ""
Say = Say + 1
ds.CopyFile yol & "\" & Dosya, anayol & "\topla\" & Dosya
Dosya = Dir$()
Loop
If x = 1 And ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar
Loop While UBound(deg) <> x
End Sub