Belirlenen Sayfalardaki Verileri Tek Sayfada Listelemek

[baydeniro]

Merhaba Arkadaşlar,
Aşağıdaki kod ile TÜM SAYFALARDAKİ verileri tek sayfada listelemek mümkün.
Acaba TÜM SAYFALARI değil de G1:G5 alanında belirlenen sayfalardaki verileri aynı sayfada listelemek mümkün müdür ?

C++:
Sheets("Liste").Select
Range("B5:B" & Rows.Count).ClearContents
With CreateObject("Scripting.Dictionary")
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "LİSTE" Then
son = sh.Cells(Rows.Count, 3).Row
If son > 3 Then
For i = 4 To son
ky = sh.Cells(i, 3)
If ky <> "" Then .Item(ky) = Null
Next i
End If
End If
Next sh
kys = .keys
For i = 0 To UBound(kys)
Cells(i + 5, "B") = kys(i)
Next i
End With
End Sub

 
 

 

[Ziynettin]

Merhaba.

Sheets("Liste").Select
Dim syf()
Range("B5:B" & Rows.Count).ClearContents
With CreateObject("Scripting.Dictionary")
syf = [G1:G5].Value
    For Each sh In ThisWorkbook.Worksheets
        For j = 1 To 5
            If syf(j, 1) <> "" Then
                If syf(j, 1) = sh.Name Then
                    son = sh.Cells(Rows.Count, 3).End(xlUp).Row
                    If son > 3 Then
                        For i = 4 To son
                            ky = sh.Cells(i, 3)
                            If ky <> "" Then .Item(ky) = Null
                        Next i
                    End If
                End If
            End If
        Next j
    Next sh
    kys = .keys
    For i = 0 To UBound(kys)
        Cells(i + 5, "B") = kys(i)
    Next i
End With

 

[baydeniro]

Merhaba.

Sheets("Liste").Select
Range("B5:B" & Rows.Count).ClearContents
With CreateObject("Scripting.Dictionary")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "LİSTE" Then
            For i = 1 To 5
                ky = sh.Cells(i, 7)
                If ky <> "" Then .Item(ky) = Null
            Next i
        End If
    Next sh
    kys = .keys
    For i = 0 To UBound(kys)
        Cells(i + 5, "B") = kys(i)
    Next i
End With

Üstad teşekkür ederim. Ama bu kod sayfa isimlerini listeledi. Aradığımız çözüm, G1:G5 alanında isimleri yazılı sayfalardaki verileri Liste sayfasında birleştirmesi idi

 

[Ziynettin]

Üstad teşekkür ederim. Ama bu kod sayfa isimlerini listeledi. Aradığımız çözüm, G1:G5 alanında isimleri yazılı sayfalardaki verileri Liste sayfasında birleştirmesi idi

Kod düzenlendi tekrar deneyin.


*** Veri alırken ve yazdırmada durumunda dizi olarak tanımlanırsa işlemiz daha hızlı sonuç verir.

 

[baydeniro]

Kod düzenlendi tekrar deneyin.


*** Veri alırken ve yazdırmada durumunda dizi olarak tanımlanırsa işlemiz daha hızlı sonuç verir.

Üstad çok teşekkür bu kod tamamdır. Acaba Birleştirme alanını "A2*" (* son satır) olacak şekilde nasıl değiştirmek gerekir acaba !

 

[Ziynettin]

Üstad çok teşekkür bu kod tamamdır. Acaba Birleştirme alanını "A2*" (* son satır) olacak şekilde nasıl değiştirmek gerekir acaba !

Örnek dosya olmadan varsayımla yazılan kod.

Sub test()
Sheets("Liste").Select
Dim syf()
Application.ScreenUpdating = 0
Range("B5:D" & Rows.Count).ClearContents
With CreateObject("Scripting.Dictionary")
syf = [G1:G5].Value
ReDim b(1 To Rows.Count, 1 To 4)
For j = 1 To 5
If syf(j, 1) <> "" Then
On Error Resume Next
Set sh = Sheets(syf(j, 1))
If Err = 0 Then
    son = sh.Cells(Rows.Count, 3).End(xlUp).Row
    If son > 1 Then
        a = sh.Range("A2:D" & son).Value
        For i = 1 To UBound(a)
            ky = a(i, 3)
            If Not .exists(ky) Then
                .Item(ky) = .Count + 1
                say = .Count
                For x = 1 To UBound(a, 2)
                    b(say, x) = a(i, x)
                Next x
            End If
        Next i
    End If
End If
On Error GoTo 0
End If
Next j
If say > 0 Then
    [B5].Resize(say, 4) = b
End If
End With
Application.ScreenUpdating = 1
End Sub

 

[Korhan Ayhan]

Alternatif;

3 yöntem uygulandı.

• ADO Yöntemi
• Dizi Yöntemi
• Kopyala-Yapıştır Yöntemi

 

[Korhan Ayhan]

Üstte ki mesajımda ki dosya revize edildi.

3 farklı yöntemle çözüm uygulandı.

 

[baydeniro]

Alternatif;

3 yöntem uygulandı.

• ADO Yöntemi
• Dizi Yöntemi
• Kopyala-Yapıştır Yöntemi

Korhan Ayhan üstadım, ilginize, desteğinize ve her bir yöntem için çok teşekkür ediyorum. 3'ü de harikulade kodlar. Çok hızlı çalışıyorlar. Emeğinize, aklınıza sağlık, sağlıcakla kalın.