birleştir kodu

[yalovam77]

Sub birlestir()

For a = 1 To Cells(65536, 1).End(xlUp).Row
Cells(a, 10) = Cells(a, 1) & "- " & Cells(a, 2) & "- " & Cells(a, 3)
Next
End Sub

selamlar yukarıdaki kodu buldum çalıştırdım ama benim için lazım olan sayfa1 de a1 den z1 kadar dolu olan sütunları aralarında / olacak şekilde sayfa2 de a1 de birleştirecek bir kod lazım hücrelere veri girildikçe otomatik olmasını istiyorum. yardımcı olurmusunuz. teşekkür ederim şimdiden

 

[Muzaffer Ali]

Merhaba.
Sayfa1in adını sağ tıklatın "Kod Görüntüle" seçin açılan kod sayfasına aşağıdaki kodu kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:Z1")) Is Nothing Then
        Dim Bak As Range
        Dim Deger As String
        For Each Bak In Range("A1:Z1")
            If Deger = "" Then
                Deger = Bak
            Else
                Deger = Deger & " / " & Bak
            End If
        Next
    End If
    Worksheets("Sayfa2").Range("A1") = Deger
End Sub

Sayfa1 de "A1:Z1" hücreleri arasında bir değişklik olduğunda kodlar çalışacak ve Sayfa2 nin A1 hücresine yazacaktır.

 

[yalovam77]

Teşekkür ederim Üstadım çalıştı ancak a dan z kadar her zaman dolu olmuyor en son dolu hücreye kadar "/ ekletmek mümkünmü
ikinciside a2 a3 satırlarına veri girildiğinde yani aşağıya doğru veri girildikçe de sayfa2 a2 hücresine sayfa2 a3 hücresine yazacak şekilde ayarlamak mümkünmü kusura bakmayın eksik anlatmışım.

 

[yalovam77]

soruma örnek dosya ekledim teşekkür ederim

 

[Muzaffer Ali]

Aşağıdaki kodları deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:Z" & Rows.Count)) Is Nothing Then
        Dim Bak As Range
        Dim Deger As String
        For Each Bak In Range("A" & Target.Row & ":Z" & Target.Row)
            If Not Bak = "" Then
                If Deger = "" Then
                    Deger = Bak
                Else
                    Deger = Deger & " / " & Bak
                End If
            End If
        Next
    End If
    Worksheets("Sayfa2").Range("A" & Target.Row) = Deger
End Sub

 

[yalovam77]

Çok teşekkür ederim Üstadım harika olmuş bir şey sorabilirmiyim bu işlem hücrelere veriyi tek tek girdikçe oluyor başka bir belgeden bir tabloyu kopyalayıp bu belgeye yapıştırsak oda olurmu teşekkür ederim.

 

[Muzaffer Ali]

Aşağıdaki kod ile olur

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:Z" & Rows.Count)) Is Nothing Then
        Dim Bak As Range
        Dim Deger As String
        Dim Hcr As Range
        For Each Hcr In Target
            Deger = ""
            For Each Bak In Range("A" & Hcr.Row & ":Z" & Hcr.Row)
                If Not Bak = "" Then
                    If Deger = "" Then
                        Deger = Bak
                    Else
                        Deger = Deger & " / " & Bak
                    End If
                End If
            Next
            Worksheets("Sayfa2").Range("A" & Hcr.Row) = Deger
        Next
    End If
End Sub

 

[yalovam77]

Teşekkür ederim

 

[Korhan Ayhan]

Alternatif olarak forumda daha önce paylaştığım K_BİRLEŞTİR kullanıcı tanımlı fonksiyonunu araştırıp kullanabilirsiniz..

 

[yalovam77]

Alternatif olarak forumda daha önce paylaştığım K_BİRLEŞTİR kullanıcı tanımlı fonksiyonunu araştırıp kullanabilirsiniz..

Teşekkür ederim Üstadım