makro çalıştığında diğer makro pasifleşsin

[kemal turan]

Merhaba uzmanlarımız,
Aşağıdaki 1 nci makromuz çalıştığında 2nci kodun pasifleştirilmesine ihtiyacım var.
Çünkü makro çalıştığında sadece a sutunu verilerini yapıştırıp diğer verileri siliyor.
Örnek dosyamızıda ekledim ilgilenirseniz memnun olurum.
1 nci makromuza 2 nci makromuzu durduran bir kod lazım.
Teşekkürler.
1 nci kod;
Sub kaydetcarı()

satır = Sheets("ceri liste").Cells(Rows.Count, 1).End(3).Row + 1
Range("A2:I20").Select
Selection.Copy
Range("B11").Select
Sheets("cari liste").Cells(satır, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("cari liste").Select
MsgBox "Kayıt işlemi tamamlanmıştır.", , "KEMAL"
Sheets("cari kayıt").Select
Range("B11").Select

End Sub

2 NCİ KOD;
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A2]) Is Nothing Then
On Error Resume Next
Sheets(CStr(Target.Value)).Select
End If
If Not Intersect(Target, [G:G]) Is Nothing Then
If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 4) = ""
Else
If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Date
If Target.Offset(0, 3) = "" Then Target.Offset(0, 3) = "TAHSİLAT"
If Target.Offset(0, 4) = "" Then Target.Offset(0, 4) = "SATIŞ-TAKSİT"
End If
End If
Son:
End Sub

 

[ExcelF1]

Uzman değilim ama,

1 nci kod;

Sub kaydetcarı()
[B][COLOR="red"][B][A1] = 1[/B][/COLOR][/B]
satır = Sheets("CARİ liste").Cells(Rows.Count, 1).End(3).Row + 1
Range("A2:I20").Select
Selection.Copy
Range("B11").Select
Sheets("cari liste").Cells(satır, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("cari").Select
MsgBox "Kayıt işlemi tamamlanmıştır.", , "KEMAL"
Sheets("cari kayıt").Select
Range("B11").Select
[COLOR="red"][B][A1] = 2[/B][/COLOR]
End Sub

2 NCİ KOD;

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="red"]if [A1]= 1 then exit sub[/COLOR]
On Error GoTo Son
If Intersect(Target, [A2]) Is Nothing Then
On Error Resume Next
Sheets(CStr(Target.Value)).Select
End If
If Not Intersect(Target, [G:G]) Is Nothing Then
If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 4) = ""
Else
If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Date
If Target.Offset(0, 3) = "" Then Target.Offset(0, 3) = "TAHSİLAT"
If Target.Offset(0, 4) = "" Then Target.Offset(0, 4) = "SATIŞ-TAKSİT"
End If
End If
Son:
End Sub

Dosyanızı incelemedim ama yukarıda şekilde bir dener misiniz. Kolay gelsin.

 

[kemal turan]

Merhaba Sn.EXCELF1
Denedim ama olmadı.İlginiz için teşekkür ederim.
Selametle kalın

 

[kemal turan]

Merhaba uzmanlarıız,
Konu günceldir.
Teşekkür ederim.

 

[kemal turan]

Merhaba uzmanlarımız,
Yukarıdaki kodun;
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 4) = ""
bölümü silinip aşağıdaki şekilde değiştirilerek sorun bir nebze çözülmüştür.
İlgilenen kardeşlerimize teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A2]) Is Nothing Then
On Error Resume Next
Sheets(CStr(Target.Value)).Select
End If
If Not Intersect(Target, [G:G]) Is Nothing Then
If Target.Value = "" Then

Else
If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Date
If Target.Offset(0, 3) = "" Then Target.Offset(0, 3) = "TAHSİLAT"
If Target.Offset(0, 4) = "" Then Target.Offset(0, 4) = "SATIŞ-TAKSİT"
End If
End If
Son:
End Sub

 

[ExcelF1]

Uzman değilim ama,

Mantığı anlatmaya çalışmıştım. Aşağıdaki şekilde deneyiniz.

Sub kaydetcarı()
    Sheets("CARİ liste").[J1] = 1
    satır = Sheets("CARİ liste").Cells(Rows.Count, 1).End(3).Row + 1
    Range("a2:ı20").Select
    Selection.Copy
    Range("B11").Select
    Sheets("cari liste").Cells(satır, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Sheets("CARİ liste").Select
    MsgBox "Kayıt işlemi tamamlanmıştır.", , "AKSAY EV CONCEPT"
    Sheets("cari kayıt").Select
    Range("B11").Select
    Sheets("CARİ liste").[J1] = 2
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Sheets("CARİ liste").[J1] = 1 Then Exit Sub
    On Error GoTo Son
    If Intersect(Target, [A2]) Is Nothing Then
 On Error Resume Next
    Sheets(CStr(Target.Value)).Select
    End If
 If Not Intersect(Target, [G:G]) Is Nothing Then
            If Target.Value = "" Then
                Target.Offset(0, 1) = ""
                Target.Offset(0, 3) = ""
                Target.Offset(0, 4) = ""
            Else
                If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Date
                If Target.Offset(0, 3) = "" Then Target.Offset(0, 3) = "TAHSİLAT"
                If Target.Offset(0, 4) = "" Then Target.Offset(0, 4) = "SATIŞ-TAKSİT"
            End If
        End If
Son:
End Sub

Kolay gelsin.

 

[kemal turan]

Merhaba Sn.F1
Çok teşekür ederim.
İnşallah bizler yavaş yavaş mantığı anlamaya başlayıp sorun olmaktan çıkıp sorun çözeriz.
İşiniz rast gitsin.
Selametle kalın

 

[ExcelF1]

Rica ederim. Kolay gelsin.