Hücreleri alt alta birleştirme (vblf ile)

[okyanus123452]

Sayın Excel Dostu;
1. Elimdeki çalışma sayfasının D-Q sütunlarında sınıflara giren öğretmen isimleri var.
2. Örneğin d4:d18 e kadar öğretmen isimlerini D2 hücresine alt alta (vblf) makro ile yazmak istiyorum.
3. Aynı şekilde e,f,g,…Q daki tüm isimleri ilgili yere yazdırmak istiyorum. Bunun için bir makro yazdım.Çalışıyor ama çok acemice ve biraz hamallık gibi.
4. Acaba bunun bir kısa yolu yok mu?
5. Aslında exceldeki birleştir fonksiyonun alt alta yazan bir makro.Ayrıca böyle bir makroyu Kullanıcı tanımlı fonksiyona çevirmek mümkün mü?
6. Örnek dosya ektedir.
7. ilgili kodların bulunduğu CommanButon: Öğretmenleri sınıflara göre dağıt.

Yazdığım kodlar
Range("D2").Value = Range("D4").Value & vbLf & Range("D5").Value & vbLf & Range("D6").Value & vbLf & Range("D7").Value & vbLf & Range("D8").Value & vbLf & Range("D9").Value & vbLf & Range("D10").Value & vbLf & Range("D11").Value & vbLf & Range("D12").Value & vbLf & Range("D13").Value & vbLf & Range("D14").Value & vbLf & Range("D15").Value & vbLf & Range("D16").Value & vbLf & Range("D17").Value & vbLf & Range("D18").Value & vbLf & Range("D19").Value

Range("E2").Value = Range("E4").Value & vbLf & Range("E5").Value & vbLf & Range("E6").Value & vbLf & Range("E7").Value & vbLf & Range("E8").Value & vbLf & Range("E9").Value & vbLf & Range("E10").Value & vbLf & Range("E11").Value & vbLf & Range("E12").Value & vbLf & Range("E13").Value & vbLf & Range("E14").Value & vbLf & Range("E15").Value & vbLf & Range("E16").Value & vbLf & Range("E17").Value & vbLf & Range("E18").Value & vbLf & Range("E19").Value
…

Range("Q2").Value = Range("Q4").Value & vbLf & Range("Q5").Value & vbLf & Range("Q6").Value & vbLf & Range("Q7").Value & vbLf & Range("Q8").Value & vbLf & Range("Q9").Value & vbLf & Range("Q10").Value & vbLf & Range("Q11").Value & vbLf & Range("Q12").Value & vbLf & Range("Q13").Value & vbLf & Range("Q14").Value & vbLf & Range("Q15").Value & vbLf & Range("Q16").Value & vbLf & Range("Q17").Value & vbLf & Range("Q18").Value & vbLf & Range("Q19").Value

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kullanıcı tanımlı fonksiyonu kullanabilirsiniz. Uyguladığınız hücrede biçimden "METNİ KAYDIR" işaretli olmalıdır. Aksi halde düz yazı olarak görünür.

Function KBİRLEŞTİR(Alan As Range)
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If KBİRLEŞTİR = "" Then
                KBİRLEŞTİR = Veri.Value
            Else
                KBİRLEŞTİR = KBİRLEŞTİR & vbLf & Veri.Value
            End If
        End If
    Next
End Function

 

[okyanus123452]

Korhan bey tek kelime ile harika. Emeğinize sağlık. Kusura bakmayın hemen cevap veremedim. PC nin başına yeni oturma imkanım oldu.
Saygı ve Sevgilerimle sağlıcakla kalın.