bir hücreye yazdığım veriyi başka hücrede alt alta sıralama

[abdullah2]

selamun aleyküm iyi günler herkese

ben a1 hücresindeki veriyi k6 hücresinden başlayıp aşağı doğru alt alta sıralayan makro arıyorum ancak k6 hücresinden yazmaya başlamalı formül
ve a1 hücresine tekrar tekrar veri yazacağım
teşekkürler şimdiden

 

[Muzaffer Ali]

Sayfa adını sağ tıklatıp "Kod Görüntüle" seçin.
Açılan kod editörüne aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SatirSay As Long
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    SatirSay = Cells(Rows.Count, "K").End(3).Row + 1
    If SatirSay < 6 Then SatirSay = 6
    Cells(SatirSay, "K").Value = Target.Value
End Sub

 

[abdullah2]

çok teşekkür ederim
yanlız şöyle bir problemim var aynı safyada a1 hücresi için değilde
mesela s3 hücresi için bu kodu da kullanmak istiyorum onu nasıl yapacagım hem a1 hem s3 hücresi için çalışmasını istiyorum

 

[Muzaffer Ali]

Konuyu anlayabilmeniz için açıklayayım.

If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub

Target: Üzerinde işlem yapılan hücre demektir.

Eğer Target = A1 hücresi değilse (Is Nothing) Kodları durdur (Exit Sub)

Hedef hücre adresini istediğiniz kadar artırabilirsiniz.

Örnek:
Sizin istediğiniz kod:
1:

If Intersect(Target, Range("A1"), Range("S3")) Is Nothing Then Exit Sub

Eğer Target = A1 yada S3 hücresi değilse kodları durdur.

2:

If Intersect(Target, Range("A1:A100")) Is Nothing Then Exit Sub

Eğer Target = A1 den A100 e kadar olan hücrelerden bir hücre değilse kodları durdur.

 

[abdullah2]

hocam elinize sağlık bilgilerinizi benimle paylaştığınız için ama
ben şu tarzda demek istiyorum
örnek
a1 hücresine yazdığım k6 hücresine
a2 hücresine yazdığım h3 hücresine
a3 hücresine yazdığım l5 hücresine yazsın istiyorum alt alta
çok teşekkürler şimdiden

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SatirSay As Long
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
SatirSay = Cells(Rows.Count, "K").End(3).Row + 1
If SatirSay < 6 Then SatirSay = 6
Cells(SatirSay, "K").Value = Target.Value

Dim satirsay1 As Long
If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
satirsay1 = Cells(Rows.Count, "H").End(3).Row + 1
If satirsay1 < 6 Then satirsay1 = 6
Cells(satirsay1, "H").Value = Target.Value
End Sub

yazdığım kod bu daha doğrusu sizin yazdığınız ben tekrar bi kod ekledim ama a2 hücresinde çalışmadı
yani bir sayfada birden çok makro çalıştıramadım

 

[Muzaffer Ali]

Aşağıdaki kodu kullanın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim SatirSay As Long
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        SatirSay = Cells(Rows.Count, "K").End(3).Row + 1
        If SatirSay < 6 Then SatirSay = 6
        Cells(SatirSay, "K").Value = Target.Value
    ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then
        SatirSay = Cells(Rows.Count, "H").End(3).Row + 1
        If SatirSay < 3 Then SatirSay = 3
        Cells(SatirSay, "H").Value = Target.Value
    ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then
        SatirSay = Cells(Rows.Count, "I").End(3).Row + 1
        If SatirSay < 5 Then SatirSay = 5
        Cells(SatirSay, "I").Value = Target.Value
    End If
    Application.EnableEvents = True
End Sub

 

[abdullah2]

çok teşekkür ederim alalh razı olsun sizden

 

[Muzaffer Ali]

Ecmain.
Kolay gelsin.

 

[direnvip]

Selam kusura bakmayın biraz yeniyim burada.Sormak istedigim şey aslında biraz kodların işleyişiyle alakalı. Safya1 A1 e yazdıgımız bilginin Sayfa2 de ki K3 hücresine yazmak için ne gibi bir degişiklik yapmam gerekir.
Şimdiden Teşekürler.

 

[Muzaffer Ali]

Cells(SatirSay, "K").Value = Target.Value

Satırını

[COLOR="Red"]sheets("sayfaadı").[/COLOR]Cells(SatirSay, "K").Value = Target.Value

şeklinde dğiştirerek yapabilirsiniz.

 

[direnvip]

Çok teşekürler ilginiz için.

Cells(SatirSay, "K").Value = Target.Value

Satırını

[COLOR="Red"]sheets("sayfaadı").[/COLOR]Cells(SatirSay, "K").Value = Target.Value

şeklinde dğiştirerek yapabilirsiniz.