İki tarih arası bilgileri getirme

[ASLAN7410]

Merhaba hayırlı sabahlar.

Ekte gönderdiğim excel dosyamda bir istatistik yapmaya çalışıyorum.

Dosyada OCAK ile ARALIK arasında sayfalarım var. En sondaki istatistik sayfasına da veri getirmek istiyorum.

C2 hücresinde OCAK, ŞUBAT.. şeklinde ayları seçiyorum.
C3 hücresinde 1.tarihi seçiyorum,
C4 hücresinde 2.tarihi seçiyorum.

Yapmak istediğim, butona bastığımda istatistik sayfası C2 hücresindeki ay'a göre
ilgili ayın sayfasındaki iki tarih aralığını istatistik sayfasına getirmesini istiyorum.

Yardımcı olur musunuz?
.

 

[askm]

Sub askm()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("İSTATİSTİK")
Set s2 = Sheets(s1.Range("C2").Value)
Tarih1 = CDate(s1.Range("C3"))
Tarih2 = CDate(s1.Range("C4"))
Dim son As Long
s1.Range("A7:K65536").ClearContents
son = s2.Range("B" & Rows.Count).End(3).Row
s2.Range("$B$1:$K$" & son).AutoFilter
s2.Range("$B$1:$K$" & son).AutoFilter Field:=1, Criteria1:= _
        ">=" & CLng(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CLng(Tarih2)

s2.Range("A2:K" & son).SpecialCells(xlCellTypeVisible).Copy Destination:=s1.Range("A7")
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[ASLAN7410]

Sayın askm, ilginiz için çok teşekkür ediyorum, ellerinize sağlık.

Göndermiş olduğunuz kod gayet güzel çalışıyor. Butona bastığımda getirilen bilgilerin sıra numarası ile birlikte geliyor, bu numaralarda haliyle karışık oluyor, bu numaralar gelmese de gelen bilgilere göre yeniden sıra numara verse olur mu?

Ayrıca getirilen sayfada filtrelemeler kalıyor, kopyala yapıştır işlemi bittikten sonra ilgili sayfanın filtreleri de tekrar açtırabilir misiniz?

 

[askm]

Sub askm()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("İSTATİSTİK")
Set s2 = Sheets(s1.Range("C2").Value)
Tarih1 = CDate(s1.Range("C3"))
Tarih2 = CDate(s1.Range("C4"))
Dim son As Long
s1.Range("A7:K65536").ClearContents
son = s2.Range("B" & Rows.Count).End(3).Row
s2.Range("$B$1:$K$" & son).AutoFilter
s2.Range("$B$1:$K$" & son).AutoFilter Field:=1, Criteria1:= _
        ">=" & CLng(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CLng(Tarih2)

s2.Range("B2:K" & son).SpecialCells(xlCellTypeVisible).Copy Destination:=s1.Range("B7")
s2.Range("$B$1:$K$" & son).AutoFilter
For i = 7 To s1.Range("B" & Rows.Count).End(3).Row
    s1.Cells(i, 1) = i - 6
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[ASLAN7410]

Sayın askm çok teşekkür ederim, ellerinize sağlık, tam istediğim gibi olmuş.

Hayırlı günler dilerim.

 

[askm]

Rica ederim. Kolay gelsin.

 

[ASLAN7410]

Sayın askm, hayırlı geceler tekrar rahatsız ediyorum.

Ekte gönderdiğim excel dosyamdaki makroyu siz göndermiştiniz, gayet güzel çalışıyor, yeni fark ettim, kodlar bazı tarihleri görmüyor.
Şuan gönderdiğim dosyadaki HAZİRAN ayı sayfasındaki tarihler dosyamdaki gerçek tarihlerdir.

Örneğin HAZİRAN sayfasındaki tarihlerin içerisine F2 ile girip çıkınca İSTATİSTİK sayfasındaki butona tıkladığımda bu sefer tüm tarihleri görüyor.
Birde ilgili sayfadan veri çekilince hangi ay'dan veri çekildi ise o aydaki filtreleri kaldırıyor.

Bu konuda yardımcı olur musunuz?
.

 

[askm]

Verileri kopyala yapıştır ile alıyorsanız aldığınız verilerin bir kısmını metin olarak algılıyordur. O ifadeleri göstermez.

 

[ASLAN7410]

Sayın askm, ASLAN sayfasında günlük girilen verileri aktar butonu ile ilgili ay sayfasına aktarıyoruz.

 

[ASLAN7410]

Sayın askm, Forum'da bulduğum aşağıdaki kod gayet güzel çalışıyor.

Sizin kod'a bu kodu uyarlıyabilir misiniz?

Önce aşağıdaki kod çalışsın, sonra sizin kod çalışsın.

Sub f2_enter()
Application.Calculation = xlCalculationManual
    Sayfa1.Range("B7").Select

For i = 7 To Sayfa1.Range("B" & Rows.Count).End(3).Row
    SendKeys "{F2}"
    SendKeys "{ENTER}"
    If ActiveCell.Row > Sayfa1.Range("B" & Rows.Count).End(3).Row Then Exit Sub
Next i
Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "RAPOR"
End Sub

 

[ASLAN7410]

Sayın askm, gönderdiğim kod İSTATİSTİK sayfasındaki C2 hücresindeki AY'ı görerek ilgili AY'a göre çalışsın.