Çalışma Kitabındaki Tüm Verileri Tek Sayfada Toplamak

[mustafa1205]

Ek'te bulunan örnek çalışmamda açıklama yapmaya çalıştım. Bilgi sistemimizden aldığımız haftalık veri raporunda yaklaşık 250 personelimizin her hafta gitmiş olduğu illeri rapor olarak almaktayız. Ancak bu bilgiler aynı çalışma kitabında tek sayfada değil her personel için bir sayfa olacak şekilde aynı çalışma kitabının içerisinde bulunmaktadır. Her sayfada A1 hücrsinde personel adı-soyadı hemen altında A2 hücresinden itibaren aşağı doğru gittiği il isimleri bulunmaktadır. Yapmak istediğim bütün sayfalardaki bilgileri "ANA SAYFA"ya toplatmaktır. Çalışmamda da açıklama yapmaya çalıştım. Teşekkür ederim.

 

[mustafa1205]

Bir çözümü olabilir mi acaba ?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Consolidate_All_Sheets()
    Dim S1 As Worksheet, Sayfa As Worksheet
    Dim Son As Long, X As Long, Veri As Variant, Say As Long
   
    Set S1 = Sheets("ANA SAYFA")
   
    S1.Range("A:B").Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 2)
   
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> S1.Name Then
            Son = Sayfa.Cells(Sayfa.Rows.Count, 1).End(3).Row
            Veri = Sayfa.Range("A2:A" & Son).Value
            For X = LBound(Veri) To UBound(Veri)
                Say = Say + 1
                Liste(Say, 1) = Sayfa.Range("A1") & "-" & Veri(X, 1)
                Liste(Say, 2) = Sayfa.Name
            Next
        End If
    Next
   
    If Say > 0 Then
        S1.Range("A1").Resize(Say, 2) = Liste
        S1.Columns.AutoFit
    End If
   
    Set S1 = Nothing
   
    MsgBox "Sayfalardaki bilgiler konsolide edilmiştir.", vbInformation
End Sub

 

[mustafa1205]

Hocam kusura bakmayın az önce deneme fırsatım oldu. Çok güzel çalışıyor. Elinize sağlık. Çok teşekkür ederim.