Listedeki istenen verileri başka sayfaya getirtmek.

[altan888]

Merhabalar; İşyerinde bu tablo ile ilgili çok sıkıntı çekiyorum. Yardımcı olanlarla şimdiden çok teşekkür ederim, Saygılar...

Ekteki Excel tablosunda 2 ayrı sheet mevcut, "Stok Hareket Dökümü" sayfasındaki tarih bazında ve alt alta listelenmiş faturaların, Stok Hareket Dökümlerindeki (D Sütunu) "1" nci aya ait olanlar ve, "I" Sütunundaki Stok "Giren Miktar" lardan, Stok Giriş Miktarı Sıfır olmayanları (Arada Stok Giriş Değeri Sıfır olanlar atlanacak) "Yük.KDV .Hazırlık" sayfasına sırasıyla liste şeklinde getirtmek istiyorum

Not: Stok Hareketleri Dökümlerindeki 2 ve 3 ncü aya ait olan fatura bazındaki stok girişlerini ve "I" Sütunundaki Stok Giren Miktarı Sıfıra eşit olanları bu sayfaya getirmek istemiyorum.
Örnek olarak Aşağıdaki listeyi kendim manuel hazırladım, bu sayfa binlerce satır olarak uzayıp gidiyor.

Fatura olan satırların G Sütununda "J- Açık Fatura" şeklinde tanımlaması var.

 

[vardar07]

Modüle ekleyip deneyiniz.

Sub veri_al()
Set sh = Sheets("Stok Hareket Dökümü")
Set sy = Sheets("Yük.Kdv.Hazırlık")
sor = InputBox("RAKAMSAL DEĞER GİRİNİZ 1;2;3 GİBİ!!!", "KAÇINCI AYIN VERİSİNİ ALACAKSINIZ?")
sy.Range("A10:C" & sy.Range("A" & Rows.Count).End(3).Row).ClearContents
sat = 10
For i = 6 To sh.Range("B" & Rows.Count).End(3).Row
a = sh.Cells(i, "D").Value: b = sor * 1
If a = b And sh.Cells(i, "I") > 0 Then
sy.Cells(sat, "A") = sat - 9 'sh.Cells(i, "A")
sy.Cells(sat, "B") = sh.Cells(i, "C")
sy.Cells(sat, "C") = sh.Cells(i, "I")
sat = sat + 1
End If
Next i
mv = sy.Range("A" & Rows.Count).End(3).Row
c = WorksheetFunction.Max(sy.Range("A10:A" & mv))
MsgBox c & " :  ADET VERİ AKTARIM YAPILDI", vbInformation
End Sub

 

[altan888]

Merhabalar

Çözüm için teşekkürler ancak, çalıştığım yerde makro kullanımına izin vermiyorlar, makrosuz bir çözümü varmıdır acaba ?

 

[vardar07]

Makrosuz inceleyin. A8 hücresindeki formulü silmeyin.

 

[altan888]

Merhabalar

Elinize sağlık çok çok teşekkür ederim, Allah razı olsun... İyi günler dilerim

 

[vardar07]

Rica ederim.