İki Makroyu Birleştirmek;

[ormann]

Günaydın;
Aşağıdaki iki makroyu tek makroda nasıl birleştiririz?

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [D46]) Is Nothing Then Exit Sub

On Error GoTo Son
Application.EnableEvents = False
If Target.Row < 6 Then
Range("D6") = ""
Else
Range("D45") = ""
End If
Application.EnableEvents = True
Son:

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D4,D6]) Is Nothing Then Exit Sub
If Target.Row = 4 Then Call aktar1
If Target.Row = 6 Then Call aktar2
End Sub

 

[monelogg]

Merhaba, şunu deneyiniz, umarım işinizi görür.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [D4:D6]) Is Nothing Then Exit Sub

On Error GoTo Son
Application.EnableEvents = False
If Target.Row = 6 Then Call aktar2
ElseIf Target.Row < 6 And Target.Row = 4 Then
Call aktar1
ElseIf Target.Row < 6 And Target.Row <> 4 Then
Range("D6") = ""
Else
Range("D4:D5") = ""
End If
Application.EnableEvents = True
Son:

End Sub

 

[ormann]

Sayın Monelog makroda hata verdi.Dosyayı ekliyorum.

 

[ZorBey_]

Merhaba
İyi Çalışmalar

On Error GoTo Son
Application.EnableEvents = False
If Target.Row = 6 Then Call aktar2
Else --- Yazanı Silip Denermisiniz

 

[ormann]

Dediğinizi yaptım.Fakat yine hata verdi.

 

[ZorBey_]

Merhaba
İyi Çalışmalar
Bu Dosya Şu Anda
Bende Hata Vermiyor
Denermisiniz.

 

[ormann]

Sayın Asr35 dosya ilk etapta hata vermiyor.Yalnız D4 ve D6 hücrelerindeki veriyi silip tekrar çalıştırdığınızda makro işlem yapmıyor

 

[halit3]

Alternatif kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D4,D6]) Is Nothing Then Exit Sub
If Target.Row = 4 Then Call aktar1
If Target.Row = 6 Then Call aktar2
Application.EnableEvents = False
If Target.Row < 6 Then
Range("D6") = ""
Else
Range("D45") = ""
End If
Application.EnableEvents = True

End Sub

 

[ormann]

Teşekkürler Halit Bey;