Düşey listeyi yatay hale getirme

[ekandil]

Merhaba,

Dosyadaki gibi düşey listelenmiş bilgiler var. Uzun bir dosya olduğu için tek tek yapılması mümkün değil. Örnek dosyadaki gibi yatay hale nasıl getirebiliriz?

Saygılarımla

 

[Ömer]

Merhaba,

Kodları kullanabilirsiniz. Eki inceleyiniz..

Option Explicit
 
Sub Birlestir()
 
Dim i As Long, c As Range, IlkAdres As String
 
Application.ScreenUpdating = False
 
Range("C2:D65536").ClearContents
Range("A:A").AdvancedFilter xlFilterCopy, Range("C1"), Unique:=True
 
For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    With Range("A:A")
        Set c = .Find(Cells(i, "C"), , LookIn:=xlValues)
        If Not c Is Nothing Then
            IlkAdres = c.Address
            Do
 
                Cells(i, "D") = Cells(i, "D") & ";" & Cells(c.Row, "B")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> IlkAdres
        End If
    End With
Cells(i, "D") = Application.Substitute(Cells(i, "D"), ";", "", 1)
Next i
 
Application.ScreenUpdating = True
End Sub

.