Excel Makro ile Yukarıdaki Satırlardan Bilgi getirme

[bjk55]

Merhaba örnek excel sayfasında bulunan (orjinal) verilere 360.09'un altına otomatik satır açıp üstteki verilerin kopyalanmasını istiyorum.Bunun için örnek bir makro çalışması yapılabilir mi. İstediğim şablon ekte yer almaktadır. Şimdiden Teşekkür ederim.

 

[volki_112]

Merhaba örnek excel sayfasında bulunan (orjinal) verilere 360.09'un altına otomatik satır açıp üstteki verilerin kopyalanmasını istiyorum.Bunun için örnek bir makro çalışması yapılabilir mi. İstediğim şablon ekte yer almaktadır. Şimdiden Teşekkür ederim.

100.01.01 yazan yerlere 120.P.PEŞİN YAZILMASI GEREK demişssin bu kısmı anlamadım. 120.P.PEŞİN yazılacaksa o zaman sarı olan yerlerde iki tene alt alta 120.P.PEŞİN yazılı gözükecek. Çünkü sarı kısımda zaten bir tane 120.P.PEŞİN yazılı ????

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu bir modüle kopyalayıp çalıştırınız.

Sub test()
    Dim Bak As Long
    Dim Borc
    Dim Alacak
    Application.ScreenUpdating = False
    For Bak = 2 To Rows.Count
        Borc = Borc + Cells(Bak, "G")
        Alacak = Alacak + Cells(Bak, "H")
        
        If Cells(Bak, "A") = "" Then
            Exit For
        Else
            If Cells(Bak, "B") = "100.01.01" Then
                Cells(Bak, "B") = "120.P.PEŞİN"
            ElseIf Cells(Bak, "B") = "360.09" Then
                Cells(Bak + 1, "B").Resize(2, 1).EntireRow.Insert
                Cells(Bak, "A").Resize(3, 6).FillDown
                Cells(Bak + 1, "B") = "100.01.01"
                Cells(Bak + 1, "G") = Borc
                Cells(Bak + 2, "B") = "120.P.PEŞİN"
                Cells(Bak + 2, "H") = Alacak
                Borc = 0
                Alacak = 0
                Bak = Bak + 2
            End If
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Tamamlandı."
End Sub