Dosyaların aktarılması hk.

[1903emre34@gmail.com]

Merhaba,

A3 hücresindeki ; Beyannameler klasör altında on iki ay dosya içerisinde pdf dosyaları bulunmaktadır, benim istediğim Commandbuttın 1'e basıp, pdf dosyaların listelenmesi, (A3:A20 aralığında) , listelendikten sonra istediğimi dosyanın aktarılması için siyah punto seçip CommandButton2 basıp B3 hücresinde aktarılması içini nasıl kod oluşturabiliriz

 

[leumruk]

Selamlar,
Verdiğim linkte bu konuyla ilgili bir çok başlık göreceksiniz.
https://www.excel.web.tr/search/18221/?q=movefile&o=date

 

[1903emre34@gmail.com]

A.s.

Konuları inceledim, çalıştıramadım.

 

[leumruk]

Selamlar,
Deneyiniz:

Sub Dosya_Listele()
klsr = "C:\Users\emre\Desktop\YILLAR\2018\ABC LTD ŞTİ\BEYANNAMELER\"
dosya = Dir(klsr & "*.pdf")
say = 2
Do While dosya <> ""
say = say + 1
Cells(say, 1) = dosya
dosya = Dir()
Loop
MsgBox "İşlem tamamlandı.", vbOKOnly, "l e u m r u k"
End Sub
Sub Dosya_Aktar()
klsr1 = "C:\Users\emre\Desktop\YILLAR\2018\ABC LTD ŞTİ\BEYANNAMELER\"
klsr2 = "C:\Users\emre\Desktop\YENİ KLASÖR\"
sonsat = Cells(Rows.Count, 1).End(3).Row
Set fls = CreateObject("Scripting.FileSystemObject")
For x = 3 To sonsat
If Cells(x, 1).Font.Bold = True Then
fls.MoveFile klsr1 & Cells(x, 1), klsr2 & Cells(x, 1)
sat = Cells(Rows.Count, 2).End(3).Row
If sat < 3 Then sat = 3
Cells(sat, 2) = Cells(x, 1)
Cells(x, 1) = ""
End If
Next
MsgBox "İşlem tamamlandı.", vbOKOnly, "l e u m r u k"
End Sub

 

[1903emre34@gmail.com]

Teşekkürler.