Bakiyesi Sıfır Olan Borçları Aktar

[cems]

Formülle istemenize rağmen, sayın İhsan Tank üstadın kodlarında revize ile ;

Option Explicit
Sub sıfır_aktar_61()
Dim ts, kaplan, UYARI, saat As Date
Dim x, y
Set x = Sheets("Ödemeler")
Set y = Sheets("Borçlar")
UYARI = MsgBox("Bakiyesi Sıfır Olanları Aktarıyorum", vbYesNo, "Onay")
If UYARI = vbNo Then Exit Sub
Application.ScreenUpdating = False
saat = Time
x.Range("A:I").ClearContents
y.Range("A2:I3").Copy Destination:=x. _
Range("A3")
kaplan = 4
For ts = 3 To y.Cells(Rows.Count, "A").End(xlUp).Row
If y.Cells(ts, "I") = 0 Then
y.Range("A" & ts & ":I" & ts).Copy Destination:=x _
.Range("A" & kaplan)
kaplan = kaplan + 1
End If
Next
Range("A4:I39").Select
ActiveWorkbook.Worksheets("Ödemeler").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ödemeler").Sort.SortFields.Add Key:=Range("H4:H39" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Ödemeler").Sort
.SetRange Range("A4:I39")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
MsgBox Format(saat - Time, "hh:mm:ss") & vbLf _
& "Sürede Bakiyesi Sıfır Olanları Aktardım", , "Bitiş"
End Sub

Bir modüle kopyalayıp çalıştırdığınızda 1 saniye kadar sürede isteğinizi gerçekleştiriyor. Eğer kod ile çözmek isterseniz işe yarayabilir.

 

[emnozdemir]

İlginize Teşekkür ederim ... Ama bu işlemi makro kodlar yardımıyla değil FORMÜL yardımıyla yapmak istiyorum.

 

[emnozdemir]

Benim soruma yardımcı olabilecek var mı acaba ?

 

[muygun]

"Borçlar Tabosu" sayfasındaki Bakiyesi sıfır olanları Formül yardımıyla "Ödemeler Tablosu" sayfasına aktarırırken, "ödeme tarihine göre" sıralı olarak (eskiden yeniye) aktarılmasını sağlayabilirmiyiz?

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[emnozdemir]

Vermiş olduğunuz formülleri kendi excell tabloma uyarlayamadım. Yardımcı olur musunuz?

 

[muygun]

Vermiş olduğunuz formülleri kendi excell tabloma uyarlayamadım. Yardımcı olur musunuz?

Merhaba;
Eki inceleyin.
İyi çalışmalar.

 

[emnozdemir]

Çok teşekkür ederim Hocam, çok sağolun...