farklı kaydet makrosu

[Emir Hüseyin Çoban]

arkadaşlar

forumda bulduğum farklı kaydet makrosunu tabloma uyarladım

Sub saveas()
ActiveWorkbook.saveas Filename:="C:\Documents and Settings\pc_oem\Desktop\KASALAR\" & ActiveSheet.Range("E1")
' buradaki hicreyi değiştirerek farklılaştırabilirsin

End Sub

Sub kayıtet()






yer = "C:\Documents and Settings\pc_oem\Desktop\KASALAR\"
yer1 = Cells(9, 12).Value & ".xls"
dosya_adı = Cells(9, 12).Value

On Error Resume Next
If Dir("C:\Documents and Settings\pc_oem\Desktop\KASALAR\") = "" Then MkDir ("C:\Documents and Settings\pc_oem\Desktop\KASALAR\")
If Dir("C:\Documents and Settings\pc_oem\Desktop\KASALAR\2010\") = "" Then MkDir ("C:\Documents and Settings\pc_oem\Desktop\KASALAR\2010\")


sat = 0
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(yer).Files
If Mid(Dosya.Name, 1, Len(Cells(9, 12).Value)) = Cells(9, 12).Value Then
sat = sat + 1
End If
Next

Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(yer & yer1)

If a = True Then
'MsgBox "Bu isimde bir dosya var"
'On Error Resume Next
DosyaSistemi.CopyFile ThisWorkbook.FullName, (yer & dosya_adı & sat) & ".xls"
Else
'On Error Resume Next
'MsgBox "Bu isimde bir dosya yok"
DosyaSistemi.CopyFile ThisWorkbook.FullName, (yer & dosya_adı) & ".xls"
End If
End Sub


ancak tablonun ismi tarih olacak e51 hücresin de 01.01.2010 yazıyor

01.01.2010 şeklinde veya noktaları yok ederek kayıt etmem mümkün mü
yardımlarınızı bekliyorum tşkler

 

[usubaykan]

Merhaba,

Tablonuzun bulunduğu yere aşağıdaki kodu dener misiniz?

WorksheetFunction.Substitute(Range("E51"), ".", "")

 

[Emir Hüseyin Çoban]

yapmaya çalıştım ama kod hata verdi,
bende yanlış yere yerleştirmiş olabilir.
tam olarak hangi kodu silip yapıştırmam gerekiyor.