Sayfa adını hücreye taşıma (sayfa adı tarih)

[rabbace]

Merhaba,

Sayfa isimlerinin günün tarihi olduğu bir dosyam var. 01.01.17, 02.01.17, 03.01.17...gibi. Ben bu sayfalardaki H36 hücrelerinin değerlerini Toplam adında bir sayfada B sütununa ve sayfa adlarını da Toplam sayfasında A sütununa getirmeye çalışıyorum.

Aşağıdaki gibi bir kod yazdım fakat sayfa adları gün atlarsa (01.01.17'den 03.01.17'ye geçerse) hata veriyor. Yardımcı olabilir misiniz?

Sub ac()

Application.ScreenUpdating = False

For i = 1 To 31

If i < 10 Then

On Error GoTo hata1


Worksheets("0" & i & ".01.17").Select
Range("H36").Select
Selection.Copy
Worksheets("Toplam").Select
Range("A" & i).Value = i & ".01.17"
Range("B" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Else

On Error GoTo hata

Worksheets(i & ".01.17").Select
Range("H36").Select
Selection.Copy
Worksheets("Toplam").Select
Range("A" & i).Value = i & ".01.17"
Range("B" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End If

Next i

hata:
hata1:

Range("D1").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(COUNTA(C[-3]),"" günde Toplam "",SUM(C[-2]),"" ton odun gelmiştir"")"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(""Günde "",AVERAGE(C[-2]),"" ortalama ton odun gelmiştir."")"
    Range("D5").Select


End Sub

Ayrıca bu dosya Ocak ayı için yapıldı, mesela Şubat ayında kullanmak istesem kodları tekrar düzenlemem gerekecek. Bunu dinamik yapabilir miyiz?

 

[rabbace]

Örnek dosya eklendi

 

[Tevfik_Kursun]

Merhaba Arkadaş,

Sub SayfaAdlari()    
    Dim syf As Worksheet
    Dim i   As Integer    
    For Each syf In Worksheets
        i = i + 1
        Sheets(1).Cells(i, "A") = syf.Name
    Next syf    
End Sub

Bu işinizi görür. Sayfa adlarının hangi sayfada listelenmesini istiyorsanız o sayfadan bu makroyu çağırınız. Yapamazsanız yardımcı olurum.
Kolay gelsin

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u dener misiniz?
İçinde bulunduğumuz yıl ve ay kriterine göre işlem yapılmaktadır.
.

[FONT="Arial Narrow"][B]Sub Toplam_Sayfası()[/B]
Set t = Sheets("Toplam")
If t.[A65536].End(3).Row > 1 Then t.Range("A2:B" & t.[A65536].End(3).Row).ClearContents
For s = 1 To Sheets.Count
    If Sheets(s).Name <> "Toplam" Then
        If [COLOR="blue"]Month(Date)[/COLOR] = (0 + Mid(Sheets(s).Name, 4, 2)) _
            And (0 + Mid([COLOR="blue"]Year(Date)[/COLOR], 3, 2)) = (0 + Mid(Sheets(s).Name, 7, 2)) Then
            satır = t.[A65536].End(3).Row + 1
            t.Cells(satır, 1) = 0 + CDate(Sheets(s).Name)
            t.Cells(satır, 2) = 0 + Sheets(s).[[B][COLOR="Red"]H36[/COLOR][/B]]
        End If: End If: Next
t.Range("A2:B" & t.[A65536].End(3).Row).Sort Key1:=t.[A1], Order1:=xlAscending
[B]End Sub[/B][/FONT]

 

[rabbace]

Merhaba Arkadaş,

Sub SayfaAdlari()    
    Dim syf As Worksheet
    Dim i   As Integer    
    For Each syf In Worksheets
        i = i + 1
        Sheets(1).Cells(i, "A") = syf.Name
    Next syf    
End Sub

Bu işinizi görür. Sayfa adlarının hangi sayfada listelenmesini istiyorsanız o sayfadan bu makroyu çağırınız. Yapamazsanız yardımcı olurum.
Kolay gelsin

Teşekkürler hocam çalışıyor. Şimdi bu getirdiği sayfalardaki H36 hücresinin değerini getirtmem gerekiyor onu nasıl yaparım? Mesela 01.01.17'de H36 değeri 100 olsun onu A2'deki 01.01.17'nin karşısına nasıl getiririm?

 

[rabbace]

Merhaba.

Aşağıdaki kod'u dener misiniz?
İçinde bulunduğumuz yıl ve ay kriterine göre işlem yapılmaktadır.
.

[FONT="Arial Narrow"][B]Sub Toplam_Sayfası()[/B]
Set t = Sheets("Toplam")
If t.[A65536].End(3).Row > 1 Then t.Range("A2:B" & t.[A65536].End(3).Row).ClearContents
For s = 1 To Sheets.Count
    If Sheets(s).Name <> "Toplam" Then
        If [COLOR="blue"]Month(Date)[/COLOR] = (0 + Mid(Sheets(s).Name, 4, 2)) _
            And (0 + Mid([COLOR="blue"]Year(Date)[/COLOR], 3, 2)) = (0 + Mid(Sheets(s).Name, 7, 2)) Then
            satır = t.[A65536].End(3).Row + 1
            t.Cells(satır, 1) = 0 + CDate(Sheets(s).Name)
            t.Cells(satır, 2) = 0 + Sheets(s).[[B][COLOR="Red"]H36[/COLOR][/B]]
        End If: End If: Next
t.Range("A2:B" & t.[A65536].End(3).Row).Sort Key1:=t.[A1], Order1:=xlAscending
[B]End Sub[/B][/FONT]

Ömer hocam tam istediğim gibi elinize sağlık. Çok teşekkürler.

 

[Ömer BARAN]

Kolay gelsin.
.