Sayfalar arsı veri aktarma

[unsal_]

Arkadaşlar merhaba,
Şöle bir dosya buldum burada yapmak istediğim sayfalar arası geçiş yapıldığında ilgili sayfanın tüm verileri geliyor. ben sadece belli tarihler arası verilerin gelmesini istiyorum format bozulmadan.Aktif olan sayfalara ilgili tarihler arası veriyi aktarmak istiyorum.

 

[Emir Hüseyin Çoban]

. . .

Pınar sayfası için kodları deneyiniz.

Private Sub Worksheet_Activate()
Dim c As Range, sat As Long, ilkadres As Variant
Range("A2:H" & Rows.Count).ClearContents
sat = 2
With Sheets("VERİ").Range("c:c")
Set c = .Find("PINAR", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do

If Sheets("VERİ").Cells(c.Row, "A") >= CDate(Sheets("VERİ").Range("J17")) And _
Sheets("VERİ").Cells(c.Row, "A") <= CDate(Sheets("VERİ").Range("L17")) Then

Cells(sat, "A") = Sheets("VERİ").Cells(c.Row, "A")
Cells(sat, "B") = Sheets("VERİ").Cells(c.Row, "B")
Cells(sat, "C") = Sheets("VERİ").Cells(c.Row, "C")
Cells(sat, "D") = Sheets("VERİ").Cells(c.Row, "D")
Cells(sat, "E") = Sheets("VERİ").Cells(c.Row, "E")
Cells(sat, "F") = Sheets("VERİ").Cells(c.Row, "F")
Cells(sat, "G") = Sheets("VERİ").Cells(c.Row, "G")
Cells(sat, "H") = Sheets("VERİ").Cells(c.Row, "H")
sat = sat + 1
Else: End If

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With
End Sub

. . .

 

[unsal_]

Teşekkür ederim.