Kopyalama

[emresbaykal]

Slmlar,

Arkadaslar bir kopyalama makrosu yaptim. bu konularda yeni oldugum icin yardiminizi rica edicem.
makro calisiyor,
B10 hücerisinden alta dogru dosya yollarini yaziyorum. kopyalama istedigim dosya uzantisini A9 a yaziyorum (bos birakinca hepsini kopyaliyor). C10 hücresine hedef klasörü yaziyorum. üstdeki kopyala butonuna tiklayinca islem tamam.

diger tarafta ise Isim butonuna tiklayinca D10 dan itibaren secilen dosyanin icindeki dosya isimlerini aliyor. E10 dan itibaren yeni isimleri yaziyorum ve "isimleri degfistir" butonuna tiklayinca isimler degisiyor.

FAKKAATTTT E sütünunda bir hücreyi bos biraktigimda makro takiliyordu. bende onun icin makronun icine " on error resume next" satiri ekledim.

bu seferde ilk bos hücrenin karsisindaki ismi .pdf olarak degistiriyor. Benim istedigim bu degisikligi yapmasin. sadece E sütununda karsiligi olan isimler degistirsin.

Tessekkürler. dosya ektedir

 

[asi_kral]

Slmlar,

Arkadaslar bir kopyalama makrosu yaptim. bu konularda yeni oldugum icin yardiminizi rica edicem.
makro calisiyor,
B10 hücerisinden alta dogru dosya yollarini yaziyorum. kopyalama istedigim dosya uzantisini A9 a yaziyorum (bos birakinca hepsini kopyaliyor). C10 hücresine hedef klasörü yaziyorum. üstdeki kopyala butonuna tiklayinca islem tamam.

diger tarafta ise Isim butonuna tiklayinca D10 dan itibaren secilen dosyanin icindeki dosya isimlerini aliyor. E10 dan itibaren yeni isimleri yaziyorum ve "isimleri degfistir" butonuna tiklayinca isimler degisiyor.

FAKKAATTTT E sütünunda bir hücreyi bos biraktigimda makro takiliyordu. bende onun icin makronun icine " on error resume next" satiri ekledim.

bu seferde ilk bos hücrenin karsisindaki ismi .pdf olarak degistiriyor. Benim istedigim bu degisikligi yapmasin. sadece E sütununda karsiligi olan isimler degistirsin.

Tessekkürler. dosya ektedir

Merhaba
Lütfen kelimeleri dikkatli kullanınız Fakat yazmanız yeterliydi
Kodu bununla değiştirip deneyin.

Sub isim_degistir()
Dim i As Long, say As Long

e = Cells(9, 6).Value

If MsgBox("D:\Deneme klasörü içersindeki dosyalar?n isimleirini deg(is,tirmek istiyormusunuz..!!??", _
vbYesNo + vbQuestion, Application.UserName) = vnno Then Exit Sub
For i = 10 To Cells(65536, "D").End(xlUp).Row
If Cells(i, "E") <> Empty Then
If Dir(Cells(7, 4).Value & "\" & Cells(i, "D").Value) <> "" Then
Name (Cells(7, 4).Value & "\" & Cells(i, "D").Value) As (Cells(7, 4).Value & "\" & Cells(i, "E").Value & "." & e)
say = say + 1
End If
End If
Next i
MsgBox say & " dosya isimi deg(is,tirildi..", vbOKOnly + vbInformation, Application.UserName

End Sub

 

[emresbaykal]

Cok tesekkürler hizli cevabiniz icin...

 

[asi_kral]

Cok tesekkürler hizli cevabiniz icin...

Kolay Gelsin.