Sayfalar Arası Veri Transferi Yaparken Nasıl Filtreleme Yapabilirim ?

[atalayozatav]

Merhaba,

Daha önce oluşturulmuş olan malzeme listesi üzerinden yeni ve sadeleştirilmiş bir mal kabul listesi yapmak istemekteyim. Resimde görmüş olduğunuz gibi Mal kabul1 e tıkladığımda istediğim verileri istediğim satır ve sütünlara atabilmekteyim.
Sorun olan kısım "işleme metodu" ve "standart koduna" göre filtreledikten sonra Mal kabul1 butonuna bastığımda yine tüm liste diğer sayfaya aktarılmakta. Yani istediğim filtrelediğim asıl veriyi hala alamamaktayım.

Konu ile ilgili acil yardımlarınızı bekliyorum. Şimdiden çok teşekkür ederim.

---- resim
https://we.tl/u7Fm1VHbzO ---- excel datası

şuanda mevcut formül;
Sub sorgu5()
Set s1 = Sheets("P-XXX")
Set s2 = Sheets("malkabull")
Dim top As Integer
basla = Time
c = 14
Z = c - 4
top = 0
s2.[a14:i1500].Delete
's2.[a14:as65536].ClearContents
For a = 20 To [av65536].End(3).Row
If s1.Cells(a, "av") = "" Then GoTo 10
s1.Range("a" & a & ":b" & a).Copy Destination:=s2.Range("a" & c & ":b" & c)
s1.Range("h" & a).Copy Destination:=s2.Range("c" & c)
s1.Range("j" & a).Copy Destination:=s2.Range("d" & c)
s1.Range("n" & a & "" & a).Copy Destination:=s2.Range("e" & c & ":g" & c)
s2.[j20:n1500].ClearContents
s2.Range("a" & c & ":b" & c).Font.Size = 11
s2.Range("a" & c & ":b" & c).HorizontalAlignment = xlCenter

c = c + 1
10 Next

bitis = Time
MsgBox "Sorgulama Süresi: " & Format(bitis - basla, "hh:mm:ss")

End Sub

 

[Mahmut Kök]

Kodunuzda ikinci bir if kontrolü olarak aşağıdaki satırı eklemeniz yeterli olacaktır.

If s1.Cells(a, "av") = "" Then GoTo 10
if (s1.rows(a).height < 1) then goto 10

 

[halilyor]

Kodlarınızın hızlı çalışması için.

Application.ScreenUpdating = False

kodlar...

Application.ScreenUpdating = True

 

[Ömer BARAN]

Merhaba.

Belgenizi ve yaptığınız işlemi tam anlamış değilim ama fikir bakımından bir şeyler söyleyeyim.

Aşağıdaki kod, P-XXX isimli sayfada, istenilen sütunlarda gerekli filtrelemeleri yaptıktan sonra,
malkabul sayfasına aktarılacak sütunlar hangileriyse o sütunların hızlıca
(çünkü kod'da for...next döngüsüyle satır satır işlem yapılmıyor)
aktarılmasını sağlar.

Ben aşağıdaki kod'da P-XXX sayfasında gerekli filtreleme yapıldıktan sonra;
-- A:C sütun aralığındaki kalan satırların malkabul sayfası F:H sütunlarına,
-- D sütun aralığındaki kalan satırların malkabul sayfası N sütununa,
-- H:J sütun aralığındaki verierin malkabul sayfası K:M sütunlarına,
aktarılacağını varsaydım.

Sütunları elbette anlamlı seçmedim. Maksatım kodun esnekliğini ortaya koymak idi.
Siz, P-XXX sayfasındaki hangi sütun makabul sayfasındaki hangi sütuna aktarılacaksa herbir sütun veya bitişik sütun aralığı için
bir satırlık kod oluşacak şekilde gerekli kod düzenlemesini kendiniz yaparsınız.

Aktarma öncesi malkabul sayfasında mevcut verilerin silinmesi için mutlaka dolu olan sütun olarak A sütununu kullandım (kırmızı renklendirdim)
önceki aktarma dolayısıyla mutlaka dolu olacak sütun başka bir sütun ise sütun adını ona göre değiştirin.
.

[B]Sub FILTRELENMIS_SAYFADA_ARALIKLI_ISTENILEN_SUTUNLARI_AKTAR()[/B]
Set s1 = Sheets("P-XXX")
Set s2 = Sheets("malkabul")
If s1.Cells(Rows.Count, 1).End(3).Row > 19 Then
    s2.Range("A20:N" & s2.Cells(Rows.Count, "[B][COLOR="Red"][SIZE="4"]A[/SIZE][/COLOR][/B]").End(3).Row).ClearContents
    If s1.Cells(Rows.Count, 1).End(3).Row > 19 Then
        s1.Range("A20:C" & s1.Cells(Rows.Count, 1).End(3).Row).Copy s2.[F20]
        s1.Range("D20:D" & s1.Cells(Rows.Count, 1).End(3).Row).Copy s2.[N20]
        s1.Range("H20:J" & s1.Cells(Rows.Count, 1).End(3).Row).Copy s2.[K20]
[COLOR="Blue"]        [B]s2sonsat[/B] = s2.Cells(Rows.Count, "[B][COLOR="red"][SIZE="4"]A[/SIZE][/COLOR][/B]").End(3).Row
            For sat = 20 To s2sonsat
                Cells(sat, "A") = sat - 19
            Next
                Range("A20:C" & s2sonsat).[B][COLOR="Red"]HorizontalAlignment = xlCenter[/COLOR][/B]
                Range("C20:E" & s2sonsat).[B][COLOR="red"]Font.Underline[/COLOR][/B] = [B][COLOR="Red"]xlUnderlineStyleNone[/COLOR][/B][/COLOR]
    End If
    MsgBox "Filtre sonucunda kalan veriler, malkabul sayfasına aktarıldı."
Else
    MsgBox "Filtre sonucunda kalan veri yok, aktarma yapılmadı."
End If
[B]End Sub[/B]

 

[atalayozatav]

Öncelikle yardımınız için çok teşekkür ederim.

İstediğimi elde edebildim.

son olarak sıra numarasını nasıl birden başlayıp sıralı bir şekilde saydırıcam ve taşıdığım bilgilerin yazı karakterlerni merkezde ortalı olmasını ve kalın olmadan altı çizgisiz gelmesini nasıl yapabilirim biliyorsanız bilgi alabilirmiyim

 

[Ömer BARAN]

Tekrar merhaba.

Önceki kod cevabını, son mesajdaki sorularınız doğrultusunda güncelledim (mavi renklendirdiğim satırlar eklendi).
s2sonsat.... şeklinde başlayan satırda büyük kırmızı renklendirdiğim sütun adı, mutlaka veri aktarılmış ve dolu olan bir sütun adı olarak kullanıldı.
Mutlaka dolu olacak (veri aktarılacak ve boş olmayacak) sütun başka bir sütun ise A harfini o sütunun adıyla değiştirin.
For...Next döngüsü satır numarası için, next'ten bir sonraki satır yatay ortalama, ondan bir sonraki satır ise metnin altı çizilmesini kaldırma için.
.

 

[atalayozatav]

Tekrar merhaba.

Önceki kod cevabını, son mesajdaki sorularınız doğrultusunda güncelledim (mavi renklendirdiğim satırlar eklendi).
s2sonsat.... şeklinde başlayan satırda büyük kırmızı renklendirdiğim sütun adı, mutlaka veri aktarılmış ve dolu olan bir sütun adı olarak kullanıldı.
Mutlaka dolu olacak (veri aktarılacak ve boş olmayacak) sütun başka bir sütun ise A harfini o sütunun adıyla değiştirin.
For...Next döngüsü satır numarası için, next'ten bir sonraki satır yatay ortalama, ondan bir sonraki satır ise metnin altı çizilmesini kaldırma için.
.

Çok teşekkür ederim.

Son olarak resimde işaretlediğim yerleri "p-xxx" sayfasından nasıl çekebilirim yardımcı olabilirmisiniz bu konu hakkındada.

 

[Ömer BARAN]

Son sorunuz net değil; çekmek derken bu bilgileri nereye (tam hücre adresi belirtiniz) yazdırmak istiyorsunuz?
Örneğin bir sütuna dolu satırlar boyunca aynı değeri mi ya da tek bir hücreye bir değeri mi vs...
.