Farklı satırlardaki verilerin tek satırda toplanması

[talatcd]

Selam arkadaşlar; ekteki dosyamda sayfa1 e sırasıyla kaydettiğim verilerin Abone nosuna göre tek satırda toplanmasını istiyorum. (Sayfa2 de olması gereken şekli mevcuttur.) Makroyla nasıl yapabilirim. Herkese kolay gelsin.

 

[veyselemre]

Sub duzenle()
    Dim aSon As Integer, lst1, w()

    Set sf1 = Sheets("Sayfa1")
    Set sf2 = Sheets("Sayfa2")

    With sf1
        aSon = .Cells(Rows.Count, "A").End(xlUp).Row
        lst1 = .Range(.Cells(2, "B"), .Cells(aSon, "P"))
        ReDim w(1 To aSon - 1, 1 To 17)
    End With

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare

        For i = 1 To UBound(lst1)
            Key = Trim(lst1(i, 2))

            If Not .Exists(Key) Then
                say = say + 1
                w(say, 1) = say
                w(say, 2) = lst1(i, 1)
                w(say, 3) = lst1(i, 2)
                .Add Key, say
                sira = say
            End If
            say = .Item(Key)
            For ii = 4 To 16
                w(say, ii) = w(say, ii) + lst1(i, ii - 1)
                w(say, 17) = w(say, 17) + lst1(i, ii - 1)
            Next ii
        Next i
    End With

    sf2.Select
    Range("2:" & Rows.Count).Clear
    [a2].Resize(say, 17).Value = w

    Set sf1 = Nothing
    Set sf2 = Nothing
    Erase lst1, w
End Sub

 

[talatcd]

Üstad ellerine sağlık çok güzel olmuş. Kendimce okullara ait bütçe harcaması yapmaya çalışıyorum. siz değerli üstadların yardımıyla inşallah bitirebilecem. Allaha emanet olun