Soru Excel Sekmelerinden Aynı Başlık Altında Yer Alan Verileri Getirme

[Sebahattinnn]

İyi günler değerli excel ustalarım. Benil excel dosyam listelerden al.xlsm adlı dosya. Bu excel dosyamda 25 ayrı ilçeye ait yoklamalarım yer alıyor. İlçelerin girdiği gayrileri ayrı bir sekmede toplamak istiyorum. excel sekmelerinden veriyi toplama.xlsm dosyasını buldum siteden. Kendime yakın bir kod var ama kendime uyarlayamadım. Kod "hayir" ı bularak çalıştığı için hayir'ı bulmadan kendime nasıl uyarlayabilirim. Bende "hayir" yazan değilde 25 ilçenin yer aldığı sekmelerde,standart çizelgemde, B13:B22 arasında dolu olanları Uzman Personel listeme, B26:B45 dolu olanları Uzman olmayan sekmeme getirmesini istiyorum.Yardımcı olurmusunuz?

 

[veyselemre]

Sub test()
    Dim ver, v, sec(1 To 3), sh As Worksheet, i%, ii%, s As Byte
    Dim perLst(1 To 2), sayPer%(1 To 2), uzmLst, uzmDLst, rng(1 To 2) As Range

    With Application
        sec(1) = .ScreenUpdating: .ScreenUpdating = False
        sec(2) = .EnableEvents: .EnableEvents = False
        sec(3) = .Calculation: .Calculation = xlCalculationManual
    End With

    ReDim uzmLst(1 To (Sheets.Count - 2) * 10, 1 To 11)
    ReDim uzmDLst(1 To (Sheets.Count - 2) * 20, 1 To 11)
    perLst(1) = uzmLst
    perLst(2) = uzmDLst

    For Each sh In Worksheets
        If sh.Name <> "UZMAN PERSONEL" And sh.Name <> "UZMAN OLMAYAN" Then
            Set rng(1) = sh.Range("B13:W22")
            Set rng(2) = sh.Range("B26:W45")
            For s = 1 To 2
                ver = rng(s).Value
                For i = 1 To UBound(ver)
                    v = Application.Index(ver, i, Array(1, 2, 5, 7, 9, 11, 14, 17, 19, 21))
                    If v(1) <> "" Then
                        sayPer(s) = sayPer(s) + 1
                        perLst(s)(sayPer(s), 1) = sayPer(s)
                        For ii = 1 To 10
                            perLst(s)(sayPer(s), ii + 1) = v(ii)
                        Next ii
                    End If
                Next i
            Next s
        End If
    Next

    Sheets("UZMAN PERSONEL").Range("A3").Resize(sayPer(1), 11).Value = perLst(1)
    Sheets("UZMAN OLMAYAN").Range("A3").Resize(sayPer(2), 11).Value = perLst(2)

    With Application
        .ScreenUpdating = sec(1)
        .EnableEvents = sec(2)
        .Calculation = sec(3)
    End With
    Beep
End Sub

 

[Sebahattinnn]

Çok teşekkür ederim, Allah Razı Olsun Sayın veyselemre üstadım.

 

[Sebahattinnn]

Sayın Veyselemre Hocam yukarıdaki kod sorunsuz çalışıyor ancak birşey soracaktım. Benim 26 ilçe sekmem harıcinde birkaçtane daha sekmem var. Onlar genel toplamların olduğu çizelgelerim. Buradaki verileride getiriyor. Bunları getirmemesi için kodun neresini değiştirmeliyim acaba? (Kod bölümünde sayfa16-Sayfa52 verileri alacak çizelgelerim benim)

 

[veyselemre]

If sh.Name <> "UZMAN PERSONEL" And sh.Name <> "UZMAN OLMAYAN" And sh.Name <> "ToplamSayfası1" And sh.Name <> "ToplamSayfası2" Then
gibi

 

[Sebahattinnn]

Çok Teşekkürler.Sağolun

 

[Sebahattinnn]

Sayın Veyselemre Hocam bu kodu çalıştırdığımın her defasında formül hesaplama otomatikten el ile ye dönüyor, formüllerimin hiçbiri çalışmıyor. Seçenekler-formüller-hesaplama seçeneklerini otomatik yapıyorum her defasında.

 

[veyselemre]

With Application
        sec(1) = .ScreenUpdating: .ScreenUpdating = False
        sec(2) = .EnableEvents: .EnableEvents = False
        sec(3) = .Calculation: .Calculation = xlCalculationManual
End With

Kod başlangıcında olan calculation ayarı sec(3) değişkenine aktarılıyor.

With Application
        .ScreenUpdating = sec(1)
        .EnableEvents = sec(2)
        .Calculation = sec(3)
End With

Kodun bitiminde de sec(3) değişkenindeki değer tekrar calculation ayarına aktarılıyor.
Yani kod çalışırken hata vermediği sürece başlangıçtaki ayarını sonda tekrar ayarlar.
Manuelken çalıştırırsanız, sonunda da tekrar manuel yapacaktır.
Otamatikte iken çalıştırırsanız, sonunda da tekrar otomatik yapacaktır.
Bu kodun daha hızlı çalışmasını sağlamak içindir.
İlgili satırları silebilirsiniz.

 

[Sebahattinnn]

Çok sağolun Değerli Hocam. Ne yaptıysanız, doğrudur . Sağolun