Klasör İçerisinde Firma İsmine Kayıtlı Excel Dosyası varmı yokmu

[hatirlabeni]

Arkadaşlar Kolay Gelsin

Sormak istediğim Soru Hazırlamış olduğum makro ile Firma kaydediyorum.Sıkıntım şu Firma önceden klasörde kaydedilmiş ise hata veriyor.Firma varsa Firma kaydı var Dosyayı Açmak istermisiniz uyarısı verip evet hayır iptal et seçenekleri gelecek

makro kodum

Sub YeniFirmaKAYDET()
'
' YeniFirmaKAYDET Makro
'
 Dim EskiDosya, YeniDosya, FirmaAdi, İhaleNo, YeniFirma As Variant
    yol = ThisWorkbook.Path
    FirmaAdi = Sheets("HİZMET HAKEDİŞ İCMAL").Range("A2")
    İhaleNo = Sheets("HİZMET HAKEDİŞ İCMAL").Range("B4")
    YeniFirma = İhaleNo & " " & FirmaAdi
    EskiDosya = yol & "\Örnek.xlsm"
    YeniDosya = yol & "\" & YeniFirma & ".xlsm"
    ' 
'********************
'Sorgulama Burada Yapılsın Firma Kaydı varsa Var diyip Makroyu Kapatsın yada Dosyayı Açsın
'*********************
'
    FileCopy EskiDosya, YeniDosya
    
    Windows("Hakediş Raporu.xlsm").Activate
    Sheets("HİZMET HAKEDİŞ İCMAL").Select
    Application.Goto Reference:="R1C1:R44C6"
    Selection.Copy
    Workbooks.Open YeniDosya
    Sheets("HİZMET HAKEDİŞ İCMAL").Select
    Application.Goto Reference:="R1C1:R44C6"
    ActiveSheet.Paste
    Application.Goto Reference:="R1C1"
    'Dosyayı Kaydet Kapat
    ActiveWorkbook.Save
    ActiveWindow.Close
    Windows("Hakediş Raporu.xlsm").Activate
    Application.Goto Reference:="R1C1"
    Application.CutCopyMode = False
    Application.Goto Reference:="R7C2:R26C6"
    Selection.ClearContents
    Application.Goto Reference:="R7C2"
    Sheets("Muayene Komisyonu").Select
    Cells.Select
    Selection.Copy
    Workbooks.Open YeniDosya
    Sheets("Muayene Komisyonu").Select
    Cells.Select
    ActiveSheet.Paste
    Application.Goto Reference:="R1C1"
    ActiveWorkbook.Save
    ActiveWindow.Close
    
    Windows("Hakediş Raporu.xlsm").Activate
    Application.Goto Reference:="R1C1"
    Application.CutCopyMode = False
    Sheets("HİZMET HAKEDİŞ İCMAL").Select
    Application.Goto Reference:="R1C1"
End Sub

 

[askm]

Örnek dosya eklerseniz daha iyi olur.

Sub YeniFirmaKAYDET()
'
' YeniFirmaKAYDET Makro
'
 Dim EskiDosya, YeniDosya, FirmaAdi, İhaleNo, YeniFirma As Variant
    yol = ThisWorkbook.Path
    FirmaAdi = Sheets("HİZMET HAKEDİŞ İCMAL").Range("A2")
    İhaleNo = Sheets("HİZMET HAKEDİŞ İCMAL").Range("B4")
    YeniFirma = İhaleNo & " " & FirmaAdi
    EskiDosya = yol & "\Örnek.xlsm"
    YeniDosya = yol & "\" & YeniFirma & ".xlsm"
    '
'********************
'Sorgulama Burada Yapılsın Firma Kaydı varsa Var diyip Makroyu Kapatsın yada Dosyayı Açsın
If Dir(YeniDosya) <> "" Then
    MsgBox "Dosya Var", vbInformation, "ASKM"
    Exit Sub
Else

'*********************
'
    FileCopy EskiDosya, YeniDosya
    
    Windows("Hakediş Raporu.xlsm").Activate
    Sheets("HİZMET HAKEDİŞ İCMAL").Select
    Application.Goto Reference:="R1C1:R44C6"
    Selection.Copy
    Workbooks.Open YeniDosya
    Sheets("HİZMET HAKEDİŞ İCMAL").Select
    Application.Goto Reference:="R1C1:R44C6"
    ActiveSheet.Paste
    Application.Goto Reference:="R1C1"
    'Dosyayı Kaydet Kapat
    ActiveWorkbook.Save
    ActiveWindow.Close
    Windows("Hakediş Raporu.xlsm").Activate
    Application.Goto Reference:="R1C1"
    Application.CutCopyMode = False
    Application.Goto Reference:="R7C2:R26C6"
    Selection.ClearContents
    Application.Goto Reference:="R7C2"
    Sheets("Muayene Komisyonu").Select
    Cells.Select
    Selection.Copy
    Workbooks.Open YeniDosya
    Sheets("Muayene Komisyonu").Select
    Cells.Select
    ActiveSheet.Paste
    Application.Goto Reference:="R1C1"
    ActiveWorkbook.Save
    ActiveWindow.Close
    
    Windows("Hakediş Raporu.xlsm").Activate
    Application.Goto Reference:="R1C1"
    Application.CutCopyMode = False
    Sheets("HİZMET HAKEDİŞ İCMAL").Select
    Application.Goto Reference:="R1C1"
End If
End Sub

 

[hatirlabeni]

Sayın Askm Vermiş Olduğunuz Kod işime yaradı Ellerinize Sağlık Teşekkür ederim.