belli tarihten sonrasını aktarma

[zamenya]

hocalarım merhabalar öncelikle kurban bayaramınızı en içten dileklerim le kutlarım.
ekteki dosyada
sayfa 1 de ki verileri user forum daki tarih secçeneğiyle tarih belirleyip o tarihten sonrasınkinleri sayfa (data)dan silip sayfa 2 ye alt alta ve sonraki aktarmalarımda sayfa2 deki enson verinin altına aktaracak şekilde yapa bilirmiyim .Kod aradım ama bulamadım bununla ilgili

yardımlarınız için şimdiden çok teşekkürler

 

[zamenya]

dosayayı eklemeyi unutmuşum şimdi ekledim

 

[Orion1]

Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet, adr1 As Range, adr2 As Range
Set s1 = Sheets("data")
Set s2 = Sheets("Sayfa2")
If MsgBox("[ " & DTPicker1.Value & _
" ] tarihinden sonrakileri Data sayfasından silip Sayfa'ye aktarmak istiyormusunuz ?" _
, vbYesNo + vbQuestion, Application.UserName) = vbNo Then Exit Sub
Application.ScreenUpdating = False
sat = s2.Cells(65536, "A").End(xlUp).Row
For i = s1.Cells(65536, "A").End(xlUp).Row To 2 Step -1
    If s1.Cells(i, "A").Value > DTPicker1.Value Then
        Set adr1 = s1.Range(s1.Cells(i, "A"), s1.Cells(i, "J"))
        Set adr2 = s2.Range(s2.Cells(sat, "A"), s2.Cells(sat, "J"))
        adr2.Value = adr1.Value
        sat = sat + 1
        adr1.Delete (xlUp)
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[zamenya]

Sayın evren bey yardımınız için çok teşekkürler ama kodda iaşaretli bölümde hata alıyorum bunu nasıl çözebilirm


Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet, adr1 As Range, adr2 As Range
Set s1 = Sheets("data")
Set s2 = Sheets("Sayfa2")
If MsgBox("[ " & DTPicker1.Value & _
" ] tarihinden sonrakileri Data sayfasından silip Sayfa'ye aktarmak istiyormusunuz ?" _
, vbYesNo + vbQuestion, Application.UserName) = vbNo Then Exit Sub
Application.ScreenUpdating = False
sat = s2.Cells(65536, "A").End(xlUp).Row
For i = s1.Cells(65536, "A").End(xlUp).Row To 2 Step -1
If s1.Cells(i, "A").Value > DTPicker1.Value Then
Set adr1 = s1.Range(s1.Cells(i, "A"), s1.Cells(i, "J"))
Set adr2 = s2.Range(s2.Cells(sat, "A"), s2.Cells(sat, "J"))
adr2.Value = adr1.Value
sat = sat + 1
adr1.Delete (xlUp)
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[zamenya]

sayın evren bey kodu nasıl düzelte bilirim

 

[Orion1]

Benim eklediğim dosyadada hat alıyormusunuz yoksa başka bir dosyaya kodları kurdunuzda başka bir dosyadamı hata alıyorsun.
Eğer başka bir dosyada çalıştırıyorsanız Sayfa2 isminde bir sayfanız yok demeketir.
O zaman set s2 = sheets("Sayfa2") yazan yere olması gereken sayfayı yazmalısınız.Normalde kodlar bende sorunsuz çalıştı.Başkalrındadd sorunsuz çalışır bir problem yok.Ancak bahsettiğim konuda bir problem olursa olur.

 

[zamenya]

evren bey sizin eklediğiniz tablo üzerinde yaptım ama verdi

 

[zamenya]

k

sat = s2.Cells(65536, "A").End(xlUp).Row

 

[1Al2Ver]

Evren bey'den ;

"O zaman set s2 = sheets("Sayfa2") yazan yere olması gereken sayfayı yazmalısınız"

Sat=

Set= şeklinde denermisiniz ?

 

[zamenya]

sayın 1Al2Ver set= şeklindede denedim ama hata veriyor

 

[1Al2Ver]

Kodu Userform'daki "Aktar" butonuna kopyaladınız mı ?

 

[1Al2Ver]

Kodu, Userform'daki "Aktar" butonuna yazdınız mı ?

Buraya yazmadıysanız bu nedenle de çalışmıyor olabilir ?

 

[zamenya]

sayın 1Al2Ver öncelikle bayramınızı kutlarım
evren beyin eklemiş olduğu dosyadan yapıyorum ordada aynı hatayı olıyorum

 

[1Al2Ver]

sayın 1Al2Ver öncelikle bayramınızı kutlarım
evren beyin eklemiş olduğu dosyadan yapıyorum ordada aynı hatayı olıyorum

Sayın zamenya, merhaba,

Teşekkür ederim, sizin de bayramınız kutlu olsun,

Evren beyin örnek dosyasını ben de indirdim ve inceledim,

Dosya hata vermedi,

Gözlemim ise ;

1) Aktarılan veriler 2 nci sayfada tarih olarak büyükten küçüğe sıralanıyor ( Örn ; 15.11.2008 üstte 01.11.2008 altta )

2) Başlık satırı aktarılmıyor,

Bunun ötesine bir sorun gözlemlemedim, belki PC'de sizin tespit edemediğiniz bir sorununuz olabilir ?

Teşekkür ederim.

 

[zamenya]

yardımlarınız için çok teşekkürler sayın evren bey ve 1al2ver galiba benim pc de probem

 

[Orion1]

Benim yolladığım dosyada hata olmuyor.Olmasınıda ihitmal yok zaten.Şimdi denedim gayet güzelçalışıyor.
O zaman problem sizin excelde var.

 

[leumruk]

Benim yolladığım dosyada hata olmuyor.Olmasınıda ihitmal yok zaten.Şimdi denedim gayet güzelçalışıyor.
O zaman problem sizin excelde var.

Belki fikir verebilir düşüncesiyle yazıyorum. Ben de denedim, aynı hatayı bende de verdi.
Belki excelin ayarlarıyla ilgili olabilir.

 

[zamenya]

sayın leumruk evet excelden kaynaklanıyor ama hala hatanın sebebini bulamadım

 

[Orion1]

Aşağıaya yazdığım kodu en üst satıra kopyalayıp denermisiniz.

Dim sat As Long

 

[zamenya]

sayın hocalarım bu hatanın sebebi ne olabiir acaba başka pc de kodlar çalışıyor ama bim pc de hata veriyor

sat = s2.Cells(65536, "A").End(xlUp).Row