Seçilen Sayfalardan İki Tarih Arası Veri Getirme

[ZorBey_]

Merhaba İyi Çalışmalar

Seçilen İlk Sayfa Ve Son Sayfa & Bu Sayfalar Arasında Kalan Sayfalardan
İki Tarih Arası Rapor Sayfasına Veri Getirmek İstiyorum
İlk Yazılan Sayfa Adından, Sağa Doğru Son Yazılan Sayfa Adı Arasındaki Sayfalardan Veri Aramalı
Örneğin Ali1 Ve Ali5 Seçildi Ama Arada 16 Da Var 16 Daki Verileride Getirebilmeli
Seçilecek Tarihler --- Sayfalarda C Sutununda
1.Aranan --- Sayfalarda D Sutununda
2.Aranan --- Sayfalarda E Sutununda
3.Aranan --- Sayfalarda F Sutununda
Şu Anda 3 Aranan Var Eğer 1 Adet Veya 2 Adet Aranan Olduğundada Kodlar Hatasız Görevini Yapabilmeli
Teşekkür Ederim İyi Çalışmalar.

 

[halit3]

kod:

Private Sub CommandButton1_Click()
Dim wsRap As Worksheet, ws As Worksheet
Dim i As Long, ss As Long
Dim baslangıc, bitis, yer1, yer2, say1, say2, sat
Dim aranan1, aranan2, aranan3
Dim bulunan1, bulunan2, bulunan3
Dim deg1, deg2, deg3, deg4


deg3 = 0
deg4 = 0

For Each ws In Worksheets
say1 = say1 + 1
If ws.Name = Sheets("Rapor").Cells(2, "c").Value Then
deg3 = say1
End If

If ws.Name = Sheets("Rapor").Cells(3, "c").Value Then
deg4 = say1
End If

Next


baslangıc = Sheets("Rapor").Cells(2, "f").Value
bitis = Sheets("Rapor").Cells(3, "f").Value
aranan1 = Sheets("Rapor").Cells(3, "h").Value
aranan2 = Sheets("Rapor").Cells(3, "ı").Value
aranan3 = Sheets("Rapor").Cells(3, "j").Value

If IsDate(baslangıc) <> True Then Exit Sub
If IsDate(bitis) <> True Then Exit Sub

deg1 = CDate(baslangıc)
deg2 = CDate(bitis)

If deg1 <= deg2 Then
yer1 = CDate(baslangıc)
yer2 = CDate(bitis)
Else
yer2 = CDate(baslangıc)
yer1 = CDate(bitis)
End If


Set wsRap = Worksheets("Rapor")
wsRap.Range("B5:N500").ClearContents


For Each ws In Worksheets
say2 = say2 + 1
If deg3 <= say2 And deg4 >= say2 Then
With ws
If .Name <> "Rapor" And .Name <> "Ara" And .Name <> "Ara1" Then
For i = 5 To .Cells(.Rows.Count, "B").End(xlUp).Row

bulunan1 = .Cells(i, "d").Value
bulunan2 = .Cells(i, "e").Value
bulunan3 = .Cells(i, "f").Value


If CDate(yer1) <= CDate(.Cells(i, "c").Value) _
And CDate(yer2) >= CDate(.Cells(i, "c").Value) Then

If bulunan1 = aranan1 _
Or bulunan2 = aranan2 _
Or bulunan3 = aranan3 Then

sat = sat + 1


ss = wsRap.Cells(Rows.Count, "B").End(xlUp).Row + 1
wsRap.Cells(ss, "b").Value = sat
wsRap.Cells(ss, "c").Value = .Name
wsRap.Cells(ss, "d").Value = .Cells(i, "B").Value
wsRap.Cells(ss, "e").Value = .Cells(i, "C").Value
wsRap.Cells(ss, "f").Value = .Cells(i, "D").Value
wsRap.Cells(ss, "g").Value = .Cells(i, "e").Value
wsRap.Cells(ss, "h").Value = .Cells(i, "f").Value
wsRap.Cells(ss, "ı").Value = .Cells(i, "g").Value
wsRap.Cells(ss, "j").Value = .Cells(i, "k").Value
wsRap.Cells(ss, "k").Value = .Cells(i, "l").Value
wsRap.Cells(ss, "l").Value = .Cells(i, "r").Value
wsRap.Cells(ss, "m").Value = .Cells(i, "s").Value
wsRap.Cells(ss, "n").Value = .Cells(i, "t").Value
wsRap.Cells(ss, "o").Value = .Cells(i, "v").Value
wsRap.Cells(ss, "p").Value = .Cells(i, "z").Value
wsRap.Cells(ss, "q").Value = .Cells(i, "ab").Value
wsRap.Cells(ss, "r").Value = .Cells(i, "ad").Value
End If
End If

Next
End If
End With

End If
Next


Range("A1").Select
End Sub

 

[ZorBey_]

Merhaba
Sayın Halit3
Tam Olarak İstenen Veriler Geliyor
Çok Güzel Örnek Bir Çalışma
Çok Teşekkür Ederim
Allah Razı Olsun.

 

[halit3]

Merhaba
Sayın Halit3
Tam Olarak İstenen Veriler Geliyor
Çok Güzel Örnek Bir Çalışma
Çok Teşekkür Ederim
Allah Razı Olsun.

Teşekkürler iyi çalışmalar