Soru Alt alta verileri şarta göre yan yana düzenleme

[emre67z]

Merhaba arkadaşlar, örnek dosya da belirtiğim üzere.


Kişilerin aile bilgilerini alt alta olarak şekilde dosyada bulunmaktadır. bu verileri yatay olarak düzenlemek istiyorum.
Herhangi bir mantık kuramadım, veri çekmek için başlıklar düzenlenebilir.

yardımcı olan herkese şimdiden teşekküre eder, sağlıklı günler dilerim.

 

[Muzaffer Ali]

Merhaba.

Sayfa1 adlı sayfanın kod sayfasına aşağıdaki kodları kopyalayıp çalıştırın.

Sub Test()
    Dim SayVeri As Long
    Dim Say As Long
    Dim Bak As Long
    Dim SayCocuk As Integer
    Dim EnFazlaCocukSayisi As Integer
    EnFazlaCocukSayisi = 4
    SayVeri = Cells(Rows.Count, "A").End(xlUp).Row
    
    For Bak = 2 To SayVeri
        With Worksheets("Olmasını İstediğim Dosya")
            If Cells(Bak, "A") <> Cells(Bak - 1, "A") Then
                SayCocuk = 0
                Say = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                .Range("A" & Say & ":E" & Say).Value = Range("A" & Bak & ":E" & Bak).Value
                .Range("F" & Say).Value = Range("E" & Bak).Value
            Else
                SayCocuk = 1 + SayCocuk
                If SayCocuk > EnFazlaCocukSayisi Then
                    MsgBox "Çocuk sayısı en fazla " & EnFazlaCocukSayisi & " olabilir." & vbLf & _
                    EnFazlaCocukSayisi & " dan fazla çocuğu olan isim: " & Cells(Bak, "B"), vbExclamation
                    Exit Sub
                End If
                .Cells(Say, SayCocuk + 6).Value = Range("E" & Bak).Value
            End If
        End With
    Next
End Sub