Farklı sayfadaki verileri tek sayfada listelemek

[abnur]

Merhaba,

Farklı sayfada olan verileri Özet sayfasında listelemek istiyorum. Konuyla ilgili yardımınız rica ederim.

 

[ÖmerBey]

Merhaba,
Örnek dosyanız için deneyiniz...

Sub kod()
Dim say As Integer, a As Integer
Dim s1 As Worksheet, s2 As Worksheet
Dim trf As String, S As String, M As String, T As String

sayfa = Array("AA", "BB", " CC")

Set s1 = Sheets("ÖZET")
trf = s1.Range("A2").Value

For Each syf In sayfa
    Set s2 = Sheets(syf)
    say = say + WorksheetFunction.CountIf(s2.Range("F:F"), trf)
Next

ReDim dz(1 To say, 1 To 3)

For Each syf In sayfa
    Set s2 = Sheets(syf)
    For a = 2 To s2.Cells(Rows.Count, "F").End(3).Row
        If s2.Cells(a, "B") <> "" Then
            S = s2.Cells(a, "B").Value
            M = s2.Cells(a, "C").Value
            T = s2.Cells(a, "D").Value
        End If
        If s2.Cells(a, "F") = trf Then
            x = x + 1
            dz(x, 1) = S
            dz(x, 2) = M
            dz(x, 3) = T
        End If
    Next
Next
s1.Range(s1.Range("B2"), s1.Cells(Rows.Count, "D").End(3)).ClearContents
s1.Range("B2").Resize(UBound(dz), UBound(dz, 2)).Value = dz
End Sub

 

[abnur]

Merhaba,
Örnek dosyanız için deneyiniz...

Sub kod()
Dim say As Integer, a As Integer
Dim s1 As Worksheet, s2 As Worksheet
Dim trf As String, S As String, M As String, T As String

sayfa = Array("AA", "BB", " CC")

Set s1 = Sheets("ÖZET")
trf = s1.Range("A2").Value

For Each syf In sayfa
    Set s2 = Sheets(syf)
    say = say + WorksheetFunction.CountIf(s2.Range("F:F"), trf)
Next

ReDim dz(1 To say, 1 To 3)

For Each syf In sayfa
    Set s2 = Sheets(syf)
    For a = 2 To s2.Cells(Rows.Count, "F").End(3).Row
        If s2.Cells(a, "B") <> "" Then
            S = s2.Cells(a, "B").Value
            M = s2.Cells(a, "C").Value
            T = s2.Cells(a, "D").Value
        End If
        If s2.Cells(a, "F") = trf Then
            x = x + 1
            dz(x, 1) = S
            dz(x, 2) = M
            dz(x, 3) = T
        End If
    Next
Next
s1.Range(s1.Range("B2"), s1.Cells(Rows.Count, "D").End(3)).ClearContents
s1.Range("B2").Resize(UBound(dz), UBound(dz, 2)).Value = dz
End Sub

Bunu excel ekledim fakat bir sonuç alamadım. Ekli halde iletmeniz mümkün müdür ?

 

[ÖmerBey]

Buyurunuz...

 

[abnur]

Buyurunuz...

Çok teşekkür ederim. Bir sorun daha olacaktı. Sayfa sayısını arttırınca kod kısmında hangi alanlara ekleme yapmam gerekir ?

 

[ÖmerBey]

sayfa = Array("AA", "BB", " CC")
Bu satıra işlem yaptırmak istediğiniz sayfaları formatı bozmadan ilave edebilirsiniz.
sayfa = Array("AA", "BB", " CC", "DD", "EE") gibi...