Kod:
Public Con As Object
Dim Alan As Range
Dim Fs As Object
Sub KlasordenKlasoreVerCoskuyu()
Dim klasor As Object
Dim hedefklasor As String
Dim Fs As Object, YazilanDosya As String, Dosya As String
For Each Alan In Sayfa1.Range("A2:A" & Sayfa1.Range("A65536").End(xlUp).Row)
hedefklasor = Alan.Offset(0, 2) & "\"
Set Fs = CreateObject("Scripting.FileSystemObject")
YazilanDosya = Alan.Offset(0, 3)
Set klasor = Fs.getfolder(Alan)
Dosya = Alan.Offset(0, 3)
If Not Fs.FolderExists(klasor) Then
MsgBox "Aktarım klasörü mevcut değil, iptal ediliyor."
Exit Sub
End If
If Not Fs.FolderExists(hedefklasor) Then
MsgBox "Hedef klasor mevcut değil, kopyalama yapılamaz."
Exit Sub
End If
Fs.copyfile klasor & "\" & Alan.Offset(0, 1), hedefklasor & Dosya
Next Alan
End Sub
Uygulama Adımları
[*]Microsoft Visual Basic for Applications penceresini (Alt + F11) açın.
[*]Project - VBAProject alanının, ekranın sol tarafında görüldüğünden emin olun. Görünmüyorsa, Ctrl + R kısayolu ile hızlıca açın.
[*]Araç çubuklarından Insert -> Module yazısına tıklayın.
[*]Alt kısma eklenecek gelecek olan Module(1) yazısına çift tıklayın.
[*]Üstteki kodu yapıştırın.
Ekli dosyalar