özel toplam

[GursoyC]

Merhaba,

bir klasörde bulunan tüm excel dosyalarının sayfa 1, sayfa 2 ve sayfa 17 haricindeki tüm sayfalarının AI55 hücresindeki değerlerini toplatmak mümkün müdür?
Böyle bir toplam yaptırmaya ihtiyacım var ama işin içinden çıkamadım.
Yardımcı olur musunuz.
Teşekkür ederim.

 

[GursoyC]

günceldir.

 

[Korhan Ayhan]

Deneyiniz.

Dosyanızda RAPOR isimli bir sayfa eklenir ve seçtiğiniz klasör altındaki dosyaların AI55 hücrelerindeki veriler dosya adı ile birlikte listelenir.

Option Explicit
 
Sub KLASOR_ALTINDAKI_DOSYALARDAN_VERI_AL()
    Dim K1 As Workbook, Klasor As Object, Dosya_Yolu As String
    Dim Dosyalar As Object, Dosya As Object, Sayfa As Worksheet
    Dim K2 As Workbook, Satir As Long, Toplam As Double
 
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir Klasor seçin !", &H100)
    If Not Klasor Is Nothing Then
        Dosya_Yolu = Klasor.Self.Path & "\"
    Else
        MsgBox "İşleme devam edebilmeniz için Klasor seçimi yapmalısınız !", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
 
    Set K1 = ThisWorkbook
 
    On Error Resume Next
    Application.DisplayAlerts = False
    K1.Sheets("RAPOR").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
 
    K1.Sheets.Add Before:=K1.Sheets(1)
    K1.ActiveSheet.Name = "RAPOR"
    Satir = 2
 
    Set Dosyalar = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
 
    For Each Dosya In Dosyalar
        If InStr(Dosya.Type, "Excel") > 0 Then
            If UCase(Split(Dosya.Name, ".")(0)) <> "ANA_DOSYA" Then
                Set K2 = Workbooks.Open(Filename:=Dosya)
                For Each Sayfa In K2.Worksheets
                    Select Case Sayfa.CodeName
                        Case "Sayfa1", "Sayfa2", "Sayfa17"
                        Case Else
                            Toplam = Toplam + Sayfa.Range("AI55").Value
                    End Select
                Next
                K1.Sheets("RAPOR").Cells(Satir, 1) = Dosya
                K1.Sheets("RAPOR").Cells(Satir, 2) = Toplam
                Satir = Satir + 1
                Toplam = 0
                K2.Close 0
            End If
        End If
    Next
 
    Set K1 = Nothing
    Set K2 = Nothing
    Set Dosyalar = Nothing
    Set Klasor = Nothing
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[GursoyC]

Korhan bey merhaba,

öncelikle cevabınız için teşekkür ederim.
Yalnız çalışmadı. Sebebi hakkında bir fikrim var.
Sanırım kodlar sayfa ismi olarak VBA kodlarındaki sayfa ismini değil de, sonradan değiştirilmiş halini alıyor.
VBA kodlarındaki kök ismi (tam olarak ismi bu şekilde mi söyleniyor bilemiyorum, bu konuda bir foto ekledim) alması için kodlarda nasıl bir değişiklik yapmalıyım?
Saygılarımla,

 

[Korhan Ayhan]

Kodu revize ettim. Tekrar deneyiniz.

 

[GursoyC]

Çok teşekkür ederim Korhan bey.
Sanırım sayfa 1, sayfa 2 ve sayfa 17'yi almaması ile ilgili bir sıkıntı var ama o kısmı kendim çözebilirim diye düşünüyorum.
Elinize sağlık.
Saygılar,