Birden fazla sayfadan veri almak

[tatar7]

Kolay gelsin
ekte göndermiş olduğum dosya da ki gibi birden fazla sayfaya girilmiş olan bilgileri rapor sayfasına süzdürdüğümde veya arattığımda verileri burada toplamasını istiyorum
yardımcı olacak üstadlara teşekkür ediyorum

 

[Necdet]

Başka Sayfalardan Veri Alma

Merhaba,

Bir çok yöntemle yapılabilir.
Basit bir çözüm sundum, umarım işinize yarar. Aşağıdaki kodları rapor sayfasının kod bölümünde olması gerekir. Birde rapor sayfasına veri doğrulama ekledim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Dim i As Integer
Dim j, Sat As Long
Sat = 2
Application.ScreenUpdating = False
Range("A3:F65536").ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "rapor" Then
        For j = 2 To Sheets(i).[B65536].End(3).Row
            If Sheets(i).Cells(j, "D") = Target Then
                Sat = Sat + 1
                Cells(Sat, "A") = Sat - 2
                Cells(Sat, "B") = Sheets(i).Cells(j, "B")
                Cells(Sat, "C") = Sheets(i).Cells(j, "C")
                Cells(Sat, "D") = Sheets(i).Cells(j, "D")
                Cells(Sat, "E") = Sheets(i).Cells(j, "E")
                Cells(Sat, "F") = Sheets(i).Cells(j, "F")
            End If
        Next j
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Aktarım Tamamlandı......."
End Sub

 

[hayri tekin]

Sn.Necdet hocam
Elinize sağlık,değişik ve hoş bir çalışma yapmışsınız.Acaba süzgüye birde hepsi seçeneğini ekleyebilirmisiniz ?
Teşekürler..

 

[tatar7]

Teşekkür ediyorum üstadım elinize sağlık

 

[Necdet]

Teşekkür ediyorum üstadım elinize sağlık

Güle güle kullanınız Sayın tatar.

Sn.Necdet hocam
Elinize sağlık,değişik ve hoş bir çalışma yapmışsınız.Acaba süzgüye birde hepsi seçeneğini ekleyebilirmisiniz ?
Teşekürler..

Aşağıdaki kodlar rapor sayfasının kod bölümünde olmalı

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then Aktar
End Sub

Aşağıdaki kodlarda bir modülde olmalı

Sub Aktar()
Dim i As Integer
Dim j, Sat As Long
Dim Kontrol As Boolean
Sat = 2
Set sr = Sheets("rapor")
Application.ScreenUpdating = False
sr.Range("A3:F65536").ClearContents
For i = 1 To Sheets.Count
    Set s1 = Sheets(i)
    If s1.Name <> sr.Name Then
        For j = 2 To s1.[B65536].End(3).Row
            Kontrol = False
            If sr.[D1] = "" Then
                Kontrol = True
            ElseIf s1.Cells(j, "D") = sr.[D1] Then
                Kontrol = True
            End If
            
            If Kontrol = True Then
                Sat = Sat + 1
                sr.Cells(Sat, "A") = Sat - 2
                sr.Cells(Sat, "B") = s1.Cells(j, "B")
                sr.Cells(Sat, "C") = s1.Cells(j, "C")
                sr.Cells(Sat, "D") = s1.Cells(j, "D")
                sr.Cells(Sat, "E") = s1.Cells(j, "E")
                sr.Cells(Sat, "F") = s1.Cells(j, "F")
            End If
        Next j
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Aktarım Tamamlandı......."
End Sub

 

[hayri tekin]

Sn.Necdet hocam,
İlginize ve emeğinize çok teşekkür ediyorum.
Saygılar,

 

[Necdet]

Sn.Necdet hocam,
İlginize ve emeğinize çok teşekkür ediyorum.
Saygılar,

Saygı benden. Güle güle kullanınız.

 

[cenderus]

bu konuya ilişkin dosya tekrar eklenmiştir

bu konuya ilişkin dosya tekrar eklenmiştir