makro listeleme

[igultekin2000]

iyi günler;
tekli sütuna göre liste oluşturma örneği buldum ama ikili seçeneğe göre liste oluşturma örneği bulamadım. KumasC sayfasında formüle göre liste oluşuyor. oluşan listeyi boş değerleri almadan Liste sayfasına almak istiyorum.
http://s8.dosya.tc/server3/wpfq7a/ornek.xlsx.html

Şimdiden teşekkürler.

 

[vardar07]

iyi günler;
tekli sütuna göre liste oluşturma örneği buldum ama ikili seçeneğe göre liste oluşturma örneği bulamadım. KumasC sayfasında formüle göre liste oluşuyor. oluşan listeyi boş değerleri almadan Liste sayfasına almak istiyorum.
Şimdiden teşekkürler.

İki sayfada ki a sütunu yardımcı sütundur.

 

[igultekin2000]

İki sayfada ki a sütunu yardımcı sütundur.

formül için teşekkürler ama rapor olmak için kullanacağım için makro olması daha pratik olacaktır.

 

[vardar07]

Modül'e ekleyip deneyiniz.

Sub aktar()
Set sl = Sheets("Liste"): Set sk = Sheets("KumasC")
son = sl.Range("D" & Rows.Count).End(3).Row + 1
sat = 3
sl.Range("A3:E" & son).ClearContents
For i = 3 To sk.Range("A" & Rows.Count).End(3).Row
If sk.Cells(i, "D") > 0 Then
sl.Cells(sat, "A") = sk.Cells(i, "A")
sl.Cells(sat, "B") = sk.Cells(i, "B")
sl.Cells(sat, "C") = sk.Cells(i, "C")
sl.Cells(sat, "D") = sk.Cells(i, "D")
sl.Cells(sat, "E") = sk.Cells(i, "E")
sat = sat + 1
End If
Next i
End Sub

 

[igultekin2000]

teşekkürler

Modül'e ekleyip deneyiniz.

Sub aktar()
Set sl = Sheets("Liste"): Set sk = Sheets("KumasC")
son = sl.Range("D" & Rows.Count).End(3).Row + 1
sat = 3
sl.Range("A3:E" & son).ClearContents
For i = 3 To sk.Range("A" & Rows.Count).End(3).Row
If sk.Cells(i, "D") > 0 Then
sl.Cells(sat, "A") = sk.Cells(i, "A")
sl.Cells(sat, "B") = sk.Cells(i, "B")
sl.Cells(sat, "C") = sk.Cells(i, "C")
sl.Cells(sat, "D") = sk.Cells(i, "D")
sl.Cells(sat, "E") = sk.Cells(i, "E")
sat = sat + 1
End If
Next i
End Sub

sorunsuz çalışıyor, teşekkürler