gib_defter beyan

[igultekin2000]

merhaba;
Gib defter bayan sisteminden alınan gelir ve gider defter dökümünü tasnifleyerek süzme yapılacak hale getirip işlem yapmak istiyorum. dökümün arasındaki boşlukları elle silmek süreklilik arz edince zaman kaybı oluyor, bunu makro ile pratik hale getirmek istiyorum. Şimdiden teşekkür ederim. örnek dökümleri ekliyorum.

 

[YUSUF44]

Makro kaydetle elde ettiğim kodları düzenleyerek ulaştığım sonuç şu şekilde:

Sub duzenle()
Application.ScreenUpdating = False
    Sheets("gider").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Columns("K:K").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns("A:S").UnMerge
        .Columns("A:R").ColumnWidth = 10
        .Columns("K:K").ColumnWidth = 150
        .Columns("A:R").EntireColumn.AutoFit
        .Cells.EntireRow.AutoFit
        .DrawingObjects.Delete
        .Rows("1:1").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        son = .Cells(Rows.Count, "A").End(3).Row
        For j = son To 2 Step -1
            If .Cells(j, "A") = "S.No" Then .Rows(j).Delete
        Next
    End With
    
    Sheets("gelir").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Columns("K:K").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns("A:S").UnMerge
        .Columns("A:R").ColumnWidth = 10
        .Columns("K:K").ColumnWidth = 150
        .Columns("A:R").EntireColumn.AutoFit
        .Cells.EntireRow.AutoFit
        .DrawingObjects.Delete
        .Rows("1:1").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        son = .Cells(Rows.Count, "A").End(3).Row
        For j = son To 2 Step -1
            If .Cells(j, "A") = "S.No" Then .Rows(j).Delete
        Next
    End With
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub

 

[igultekin2000]

Makro kaydetle elde ettiğim kodları düzenleyerek ulaştığım sonuç şu şekilde:

Teşekkür ederim, sorunsuz çalışıyor, elinize sağlık, iyi çalışmalar.