Olmayan sayfadan veri alma

[huseyinvurkan]

Şablona göre açılacak sayfalardan veri almak istiyorum. Şöyle ki:

Kulüpler sayfası ana sayfam. Bu sayfada kulüp adlarını yazıp enter yapınca o isimdeki kulüp sayfası oluşturuluyor.

Oluşturulan Bu sayfaların E41:M41 aralığındaki net toplamlarını ya dinamik olarak veya bir düğme aracılığıyla KULÜPLER sayfamdaki ilgili yerlere nasıl alabilirim acaba. Daha önceki bir çalışmamda Sayın Muygun :

Sub sayfa_toplamlarını_al()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("AİDAT").Range("d3:g65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("AİDAT")
For i = 3 To s1.Range("A65536").End(xlUp).Row
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
If s1.Cells(i, "a") = s2.Cells(1, "b") Then
s1.Cells(i, "d") = s2.Cells(2, "h") '1.dönem yazılıyor
s1.Cells(i, "e") = s2.Cells(2, "I") '2.dönem yazılıyor
s1.Cells(i, "f") = s1.Cells(i, "d") - s1.Cells(i, "e") '2 dönem toplamı
's1.Cells(i, "g") = s1.Cells(i, "f") / s1.Cells(i, "b") 'kişi sayısına göre yatan miktarın ortalaması alınıyor
End If
Next i
Call verileri_sırala
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Şeklinde bir kod yazarak benzer bir sorunu çözmüştü. Bu kod yeni çalışmama uyarlanabilir mi acaba?
Şimdiden Teşekkürler.


http://www.dosya.tc/server8/dnz8c9/KULUP_AIDAT_v3.xls.html

 

[huseyinvurkan]

Sayın Hocalarım, mesajı güncellemek için :

Sub sayfa_toplamlarını_al()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("KULÜPLER").Range("d2:L65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("KULÜPLER")
For i = 2 To s1.Range("B65536").End(xlUp).Row
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
If s1.Cells(i, "D") = s2.Cells(1, "L") Then
s1.Cells(i, "d") = s2.Cells(41, "E")
s1.Cells(i, "e") = s2.Cells(41, "F")
s1.Cells(i, "f") = s2.Cells(41, "G")
s1.Cells(i, "G") = s2.Cells(41, "H")
s1.Cells(i, "H") = s2.Cells(41, "I")
s1.Cells(i, "I") = s2.Cells(41, "J")
s1.Cells(i, "J") = s2.Cells(41, "K")
s1.Cells(i, "K") = s2.Cells(41, "L")
s1.Cells(i, "L") = s2.Cells(41, "M")

's1.Cells(i, "g") = s1.Cells(i, "f") / s1.Cells(i, "b") 'kişi sayısına göre yatan miktarın ortalaması alınıyor
End If
Next i
'Call verileri_sırala
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub


yukarıdaki kod üzerinde biraz uğraştım. Veriler geliyor ama yerli yerine oturmuyor. Sadece 4. satıra 2. satırın verileri geliyor. Ne yapmam lazım. Yardım eder misiniz

 

[huseyinvurkan]

Ustalar erkenden tatile çıktı galiba

Bu kod veya işimi görecek başka bir kod konusunda hala yardım bekliyorum. Ramazandan mı nedir sabırsızlanıyorum

 

[Korhan Ayhan]

KULÜPLER isimli sayfanızdaki formülleri revize edin.

D2;

=EĞERHATA(EĞER(DOLAYLI("'"&$B2&"'!"&ADRES(41;SÜTUN()+1))="";"";DOLAYLI("'"&$B2&"'!"&ADRES(41;SÜTUN()+1)));0)

Bu formülü yana ve alt hücrelere doğru sürükleyin.

Sonra sayfanızın arka planında çalışan sayfa ekleme kodunu aşağıdaki gibi değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bitti
    Dim Sayfa As String
    If ActiveSheet.Name <> "KULÜPLER" Then
        Sheets("KULÜPLER").Select
    Else
        Sayfa = Target.Value
        If Not SayfaVarMi(Sayfa) Then
            If Sayfa <> "" Then Sheets(Sayfa).Select
            End If
            Range("D" & Target.Row & ":L" & Target.Row).FillDown
        End If
    Exit Sub
bitti:
    If Intersect(Target, Sheets("KULÜPLER").[B2:B55]) Is Nothing Then Exit Sub
    If Not SayfaVarMi(Sayfa) Then
        Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Target.Value
        MsgBox Target.Value & " Sayfası Açıldı......"
        Sheets("KULÜPLER").Select
        Range("D" & Target.Row & ":L" & Target.Row).FillDown
    End If
End Sub

 

[huseyinvurkan]

Sayın Korhan Bey neden bilmiyorum ama verdiğiniz kod

If Not SayfaVarMi(Sayfa) Then

satırında hata verdi.

Şayet dinamik olamıyorsa bir düğmeye bağlı kod da olabilir

 

[Korhan Ayhan]

Hüseyin Bey,

Sadece Private Sub Worksheet_Change(ByVal Target As Range) kodunu yenileyin. Diğer fonksiyon kodları kalsın.

 

[huseyinvurkan]

Sayın Korhan Hocam Emeğine sağlık tam istediğim gibi çalıştı. Teşekkür ederim. Dosyayı tamamlamak için ihtiyaç olursa inşallah yine yazarım.