Veri Kaydında Filtreleme Problemi

[speech_free]

Herkese merhaba,

Veri girişi sayfasında stok bilgilerim bulunuyor. Buradan Hareketlere İşle butonuna bastığımda Stok Hareketleri sayfasındaki son dolu satıra bunu aşağıdaki kod yardımı ile yazıyor fakat şöyle bir problem var. Stok hareketleri sayfasında örneğin 500 satır var ve ben bir filtreleme yaptığımda görünen satır sayısı 350'ye düşüyor. Bu halde bırakıp Hareketlere İşle butonuna basınca 351. satırdan itibaren yazıyor. Tabii ki orada aslında önceden girilmiş veriler var. Onun üstüne yazıyor. Bunu şimdi farkettim ve son derece moralim bozuldu çünkü eski sistemi yeni sisteme aktarırken bir sürü veri girmiştim. Şimdi hepsini baştan yapmam gerekecek.

Bahsettiğim problemi çözmenin bir yolu var mıdır?

Sub deneme()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim bul As Range, satir As Long
    Set s1 = Sheets("Veri Girişi")
    Set s2 = Sheets("Stok Hareketleri")
    Application.ScreenUpdating = False
    For Each bul In s1.Range("P2:P" & s1.Range("P65536").End(3).Row)
    If bul.Value <> "" Then
    satir = satir + 1
    bul.EntireRow.Copy
    s2.Select
    sat = Sheets("Stok Hareketleri").Cells(65536, "A").End(xlUp).Row + 1
    Sheets("Stok Hareketleri").Range("A" & sat).PasteSpecial xlPasteValues
    End If
    Next bul
    [a1].Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[numan şamil]

Merhaba
Her ihtimale karşı dosyanızın kopyasında dener misiniz
hata verirse Kırmızı boyalı kodları kendinize uyarlayınız

Sub deneme()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim bul As Range, satir As Long
    Set s1 = Sheets("Veri Girişi")
    Set s2 = Sheets("Stok Hareketleri")
    Application.ScreenUpdating = False
    For Each bul In s1.Range("P2:P" & s1.Range("P65536").End(3).Row)
    If bul.Value <> "" Then
    satir = satir + 1
    bul.EntireRow.Copy
    s2.Select
    [COLOR="Red"]s2.[A1:A65536].End(3).AutoFilter Field:=1[/COLOR]
    sat = Sheets("Stok Hareketleri").Cells(65536, "A").End(xlUp).Row + 1
    Sheets("Stok Hareketleri").Range("A" & sat).PasteSpecial xlPasteValues
    End If
    Next bul
    [a1].Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[speech_free]

Numan bey hızlı dönüşünüz için teşekkür ediyorum. Hareketlere İşle butonuna bastığımda hata alıyorum ve hata olarak

Sheets("Stok Hareketleri").Range("A" & sat).PasteSpecial xlPasteValues

bu satır sarıya boyanıyor. Kod içine yazdığınız satırın tam olarak Türkçe'si nedir? Ona göre belki düzenleme yapmam daha rahat olabilir.

 

[speech_free]

Sorunumu şu şekilde hallettim. Bir makro kaydettim ve filtrelemeyi temizledim. Başına da eğer koyarak filtre yoksa kodu çalıştırmamasını söyledim. Bu şekilde Stok Hareketlerine kayıt yapmadan önce orada bir filtre varsa önce filtreyi temizliyor. Bu da filtre temizleme kodu.

Sub filtretemizle()
    Sheets("Stok Hareketleri").Select
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    Sheets("Veri Girişi").Select
End Sub

 

[numan şamil]

Merhaba
Çözüm bulduğunuza sevindim
s2.[A1:A65536].End(3).AutoFilter Field:=1
A sütunundaki filitrelenmiş verileri gösterir(sadece A sutunu filitreliyse)