Seçilen veriye göre sütunlardaki değeri birleştime

[abcd_efe]

arkadaşlar aşağıdaki macro sadece b3 hücresindeki değişiklik için çalışıyor. örneğin b3 b20 arasındaki tüm hücrelerde çalışması için ne yapmam gerekiyor acaba?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sat As Long
For sat = 3 To Cells(65536, "f").End(xlUp).Row
If Cells(sat, "f") Like [b3] Then
[b3] = Cells(sat, "h") & "- " & Cells(sat, "ı") & "-" & Cells(sat, "j")
End If
Next
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [H3:J20]) Is Nothing Then Exit Sub
Target.Offset(0, -1 * (Target.Column - 2)) = Range("H" & Target.Row) & " -" & _
Range("I" & Target.Row) & " -" & Range("J" & Target.Row)
End Sub

.

 

[abcd_efe]

Sayın Ömer öncelikle ilginiz ve emeğiniz için teşekkür ederim. benim gönderdiğim kod hangi hücrede çalışılıyorsa aynı hücrenin üzerinde değişiklik yapıyor. sizin gönderdiğiniz kod çalışılan hücrenin sağ tarafına bilgi atıyor. benim istediğim aslında tanımlanmış belli bir aralıktaki (b3:b20) gibi bu aradaki hücrelerde seçim yapıldığında seçim yapılan hücrenin değişmesi. olayı daha iyi anlatabilmek için ekte dosya gönderdim.

 

[Ömer]

Bu şekilde deneyin.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
If Intersect(Target, [A26:A35]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("A1") = Target.Value ' A1  yardımcı hücre olarak kullanılmıştır.
For i = 28 To 32
    Set c = Range("AA1:AA15").Find(Range("A1"), LookIn:=xlValues)
    If Not c Is Nothing Then
        Target = Target & Application.Rept(" ", 12) & Cells(c.Row, i)
    End If
Next i
Target = Right(Target, Len(Target) - Len(Range("A1")))
Range("A1").ClearContents
Application.EnableEvents = True
End Sub

.