Satırı Sütuna Çevirme

[steppe]

Sayfa2 de Alt alta yazılan ad soyad,adres ve telefonları Sayfa1'e sütunlar şeklinde aktarmak istiyorum.Yalnız burada adres satırı bazen 1, bazen 2 ,bazen3 ,bazen 4 satır oluyor.Adres satırını sayfa1'de tek satırda birleştirmek istiyorum.Yardımlarınız için şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Kodları inceleyiniz.

Sub Adres_Duzenle()
    
    Dim i   As Long, _
        j   As Long, _
        Ad  As String, _
        Adr As String, _
        Tel As String, _
        Sh1 As Worksheet, _
        Sh2 As Worksheet
        
    Set Sh1 = Sheets("Sayfa1")
    Set Sh2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    
    i = Sh1.Cells(Rows.Count, "A").End(3).Row + 1
    Sh1.Range("A2:C" & i).ClearContents
    
    i = 1
    j = 1
    Do
        If Sh2.Cells(i, "A").Font.Bold = True Then
            Ad = Sh2.Cells(i, "A")
        ElseIf Not Sh2.Cells(i, "A") Like "Tel:*" Then
            If Adr = "" Then
                Adr = Sh2.Cells(i, "A")
            Else
                Adr = Adr & Chr(10) & Sh2.Cells(i, "A")
            End If
        Else
            Tel = Split(Sh2.Cells(i, "A"), "Tel: ")(1)
            j = j + 1
            Sh1.Cells(j, "A") = Ad
            Sh1.Cells(j, "B") = Adr
            Sh1.Cells(j, "C") = Tel
            Ad = ""
            Adr = ""
            Tel = ""
        End If
                
        i = i + 1
    Loop Until Sh2.Cells(i, "A") = ""
    
    Application.ScreenUpdating = True
    
    MsgBox "VERİLER LİSTELENMİŞTİR....", vbInformation, "Excel.Web.Tr"
    
End Sub

 

[steppe]

Necdet Yeşerten Hocam,
Çok teşekkür ederim.Bir ricada daha bulunabilir miyim?Adres satırını birleştirirken hücrede alt alta birleştirme olmuş,acaba yanyana birleştirme olamaz mı?

 

[Necdet]

Necdet Yeşerten Hocam,
Çok teşekkür ederim.Bir ricada daha bulunabilir miyim?Adres satırını birleştirirken hücrede alt alta birleştirme olmuş,acaba yanyana birleştirme olamaz mı?

Kodda gördüğünüz CHR(10) yerine " " (iki tırnak arası boşluk) koyunuz.

 

[steppe]

Necdet Hocam,
Yardımların için teşekkür ederim.Bir sorunla karşılaştım Ad Soyad kalın olmazsa adres kısmı ile birleştiriyor.Bazen ad soyad bold olmayabiliyor.Bu sorunu nasıl çözebiliriz.