Makrodaki hatayı bulamıyorum..

[acolkesen1]

Herkese iyi akşamlar. Değerli Evren Gizlen , Ferhat Pazarçevirdi ve ECYavuz arkadaşlarımızın yardımlarıyla bu noktaya getirdiğim aşağıdaki makroda, kayıt yapılan klasör içinde aynı isimde başka bir dosya varsa kayıt yapmaması ve uyarı mesajı vermesi için kırmızı rekle yazılmış olan kodları ilave ettim. Ancak aynı ismde dosya olmasına rağmen kayıt yapıp eskisi ile yenisini değiştiriyor. Nerde hata olduğunu bir türlü bulamıyorum. Lütfen yardım eder misiniz?
Sub devir()

ActiveSheet.Unprotect
Range("B4").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("B10").Select
Selection.Locked = True
Selection.FormulaHidden = False
If MsgBox("BİLGİLER KAYDEDİLİP PROGRAM KAPATILACAK. DEVAM ETMEK İSTİYOR MUSUNUZ?", vbYesNo, "") = vbNo Then Exit Sub
For i = 1 To Worksheets.Count
If Range("B10").Value = "" Then
MsgBox "DEVİR YAPACAĞINIZ YILI YAZINIZ.."
Exit Sub
End If
Next i

If IsDate(Range("B4")) = False Then
MsgBox "DEVİR TARİHİNİ BELİRLEYİNİZ!", vbCritical, "UYARI"
Exit Sub
Else

End If
If Date < Range("B4") Then
MsgBox Range("B4") & " TAR&#304;H&#304;NDEN &#214;NCE DEV&#304;R YAPAMAZSINIZ", vbCritical, "UYARI"
Exit Sub
Else

If Dir("D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])) <> "" Then
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE DEV&#304;R YAPINIZ!", vbCritical, "UYARI"
Exit Sub
Else

End If
Sheets("B&#304;LAN&#199;O").Select
Cells.Select
Selection.Copy
Sheets("DEV&#304;R").Select
Cells.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets("BEKLEY&#304;N&#304;Z").Select

ActiveWorkbook.SaveAs "D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])
End If
Application.Quit
End Sub

 

[Orion1]

Kırmızı satırı aşağıdaki satırla değiştirerek denermisiniz.

If Dir("D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10] & ".xls")) <> "" Then
MsgBox "BU İSİMDE BİR DOSYA VAR, BAŞKA İSİMLE DEVİR YAPINIZ!", vbCritical, "UYARI"

 

[ftekin]

On Error Resume Next
If Dir("D:\APARTMAN\" & Cells(10, 1) & Cells(10, 2) & ".xls") <> "" Then
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE DEV&#304;R YAPINIZ!", vbCritical, "UYARI"
Else

Exit Sub
End If

 

[ftekin]

ayn&#305; anda evren arkada&#351;ta cevap yazm&#305;&#351; ))))

 

[acolkesen1]

De&#287;erli Evren Gizlen, size ne kadar te&#351;ekk&#252;r etsem azd&#305;r..Emin olun g&#252;n boyunca i&#351;ten f&#305;rsat bulduk&#231;a yapmaya &#231;al&#305;&#351;t&#305;m, ama ba&#351;&#305;ma a&#287;r&#305;lar girmeye ba&#351;lam&#305;&#351;t&#305;..Hani biraz da kendim bir &#351;eyler yapay&#305;m istiyorum Tekrar te&#351;ekk&#252;r ederim, elinize sa&#287;l&#305;k..Esenlikler dilerim..

 

[acolkesen1]

Sevgili ftekin, Evren Gizlen hocam&#305;z&#305;n cevab&#305; h&#305;z&#305;r gibi yeti&#351;ti ama, size de te&#351;ekk&#252;r ederim.. Cevap verme nezaketiniz i&#231;in..

 

[Orion1]

Değerli Evren Gizlen, size ne kadar teşekkür etsem azdır..Emin olun gün boyunca işten fırsat buldukça yapmaya çalıştım, ama başıma ağrılar girmeye başlamıştı..Hani biraz da kendim bir şeyler yapayım istiyorum Tekrar teşekkür ederim, elinize sağlık..Esenlikler dilerim..

Rica ederim.
İyi çalışmalar.