Private Sub CommandButton1_Click()
Dim h, klas As String
Dim a As Long
Dim dc, kayıt
Set dc = CreateObject("Scripting.FileSystemObject")
Set kayıt = CreateObject("wscript.Shell")
klas = kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator & "ÇALIŞMA2"
If dc.FolderExists(klas) = False Then _
dc.CreateFolder klas
For a = 2 To Cells(Rows.Count, "B").End(3).Row
h = Dir(Cells(a, "B").Value & "\" & Cells(a, "C").Value & "*.*", vbDirectory)
FileCopy Cells(a, "B").Value & "\" & h, klas & "\" & h
Next
MsgBox "İşlem Bitti"
End Sub