Makro kodunu düzenleme

[mersilen]

Merhabalar,
Bir başka konudaki sorunu çözerken takıldım.
1 den 5 e kadar ki sayfalarda bir hücrede değişiklik yapınca burdaki değeri data sayfasına yazdırmak istiyorum.
1. sayfa için kod çalışıyor ama diğer sayfalarda uyarlayamadım.
Yardımcı olur musunuz?

Bunu workbook sayfasına mı yazmalıyız?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo Son

If Intersect(Target, Sheets("1").Range("K3")) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets("1").Range("K3")

If Intersect(Target, Sheets("2").Range("L3")) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets("2").Range("L3")

If Intersect(Target, Sheets("3").Range("H3")) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets("3").Range("H3")

If Intersect(Target, Sheets("4").Range("O3")) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets("4").Range("O3")

If Intersect(Target, Sheets("5").Range("J3")) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets("5").Range("J3")

Son:
End Sub

 

[halit3]

Kodu bununla değiştirin.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Row <> 3 Then Exit Sub
ad = ActiveSheet.Name
If ad = "1" Then
If Target.Address = Range("K3").Address Then Sheets("data").Cells(4, "b") = Range("K3")
ElseIf ad = "2" Then
If Target.Address = Range("L3").Address Then Sheets("data").Cells(4, "b") = Range("L3")
ElseIf ad = "3" Then
If Target.Address = Range("H3").Address Then Sheets("data").Cells(4, "b") = Range("H3")
ElseIf ad = "4" Then
If Target.Address = Range("O3").Address Then Sheets("data").Cells(4, "b") = Range("O3")
ElseIf ad = "5" Then
If Target.Address = Range("J3").Address Then Sheets("data").Cells(4, "b") = Range("J3")
End If
End
End Sub

 

[mersilen]

Halit hocam teşekkürler.
Sorunsuz çalışıyor.

 

[mersilen]

Tekrar merhaba Halit hocam

Bilgi amaçlı soruyorum
Aşağıdaki yöntem mümkün mü acaba?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

ad = ActiveSheet.Name
If ad <> "1" Or ad <> "2" Or ad <> "3" Or ad <> "4" Or ad <> "5" Then Exit Sub

If Intersect(Target, Sheets(ad).Cells(3, Target.Column)) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets(ad).Cells(3, Target.Column)


Sheets("data").Cells(14, "a") = ad
End Sub

 

[halit3]

Tekrar merhaba Halit hocam

Bilgi amaçlı soruyorum
Aşağıdaki yöntem mümkün mü acaba?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
ad = ActiveSheet.Name
If ad <> "1" Or ad <> "2" Or ad <> "3" Or ad <> "4" Or ad <> "5" Then Exit Sub
 
If Intersect(Target, Sheets(ad).Cells(3, Target.Column)) Is Nothing Then Exit Sub
Sheets("data").Cells(4, "b") = Sheets(ad).Cells(3, Target.Column)
 
 
Sheets("data").Cells(14, "a") = ad
End Sub

ad = ActiveSheet.Name
'sayfanın adı
If ad <> "1" Or ad <> "2" Or ad <> "3" Or ad <> "4" Or ad <> "5" Then Exit Sub
'sayfanın adı yukarıdaki sayfa (1,2,3,4,5)isimlerine eşit değilse kodu durduruyor
If Intersect(Target, Sheets(ad).Cells(3, Target.Column)) Is Nothing Then Exit Sub
'Hücrenin değeri aktif sütündaki 3. satırdaki değere eşitse kodu durduruyor
Sheets("data").Cells(4, "b") = Sheets(ad).Cells(3, Target.Column)
'ilgili şartlar oluştuğu anlaşılıyor data sayfasına 3. satır ile hücrenin sütünunun kesiştiği hücre değerini aktarıyor.
Sheets("data").Cells(14, "a") = ad
'buradada ilgili şartlar oluştuğu anlaşılıyor ve data sayfasına aktif sayfanın adını alıyor.


Şimdi bu yöntemin yaptığı işlemi yukarıya yazdım.

 

[mersilen]

Halit hocam cevap için teşekkürler.

Ben kodun çalışmasını istiyorum, ama kod çalışmıyor.Muhtemelen aşağıdaki yerde mi hata var?Kodun çalışması için bunu nasıl düzenlememiz gerekir.

If Intersect(Target, Sheets(ad).Cells(3, Target.Column)) Is Nothing Then Exit Sub
'Hücrenin değeri aktif sütündaki 3. satırdaki değere eşitse kodu durduruyor
ben burda bir sayfadan bir hücreyi seçince ona devam et demek istiyorum.

 

[halit3]

Halit hocam cevap için teşekkürler.

Ben kodun çalışmasını istiyorum, ama kod çalışmıyor.Muhtemelen aşağıdaki yerde mi hata var?Kodun çalışması için bunu nasıl düzenlememiz gerekir.

If Intersect(Target, Sheets(ad).Cells(3, Target.Column)) Is Nothing Then Exit Sub
'Hücrenin değeri aktif sütündaki 3. satırdaki değere eşitse kodu durduruyor
ben burda bir sayfadan bir hücreyi seçince ona devam et demek istiyorum.

Dikkat ederseniz yukarıda açıklama yapmıştım.

Eğer sayfanın herhangibir hücresinde kodu çalıştırmak istiyorsanız yukarıdaki bölümü silmeniz gerekiyor.