çoklu sayfada veri bul

[mithrill74]

öncelikle herkese merhabalar.
ekte göndermiş olduğum örnek dosyada sayfa adını değiştirdiğimde adı değişen sayfalardaki verileri arayıp listelemiyor.
bu konuda yardımcı olabilirmisiniz.
emeği geçen herkese şimdiden teşekkür ederim.))
herkese iyi çalışmalar

NOT: ekteki örneği foruma ekleyen arkadaşımıza da teşekkürü bir borç biliyorum.

 

[mithrill74]

arkadaşlar bunu çözmem benim için çok önemli.
yardımcı olabilirseniz sevinirim.
teşekkürler

 

[mithrill74]

yardımcı olabilecek kimse yokmu

 

[AS3434]

Sayın mithrill74

Sayfa isimlerinde "Sınıf" kelimesi geçmezse makro çalışmaz. Sayfa adlarını ne yapmak istiyorsunuz mesela?

 

[AS3434]

Sayın mithrill74

If Left(Sheets(i).Name, 4) = "Yuva" Or Right(Sheets(i).Name, 5) = "Sınıf" Then

Makronun bu satırı sayfa isimlerinde "yuva" veya "sınıf" kelimesini alarak çalışıyor.

Bu kısma istediğiniz sayfa isimlerini yazarsanız makroyu çalıştırabilirsiniz.

Dikkat!! bu satırdan makroda iki adet var.

 

[Ferhat Pazarçevirdi]

Raporlama -Sub Raporlama()- adlı prosedürü, aşağıdaki gibi değiştirin. Kırmızı yazılı satırlar değiştirilmiştir.

Kodun, önceki halinde veri toplama koşulu, sadece Yuva ve Sınıf ile başlayan sheet'lerde yapılıyordu. Tabi bu da kodu yazan arkadaşımızın, ihtiyacına göre dizayn edilmiş olduğunu gösteriyor. Bu koşulu kaldırdık ve bunun yerine Raporlama sayfası dışındaki tüm sheet'leri işleme tabi tuttuk.

Şimdi sayfa isimlerini istediğiniz gibi değiştirebilirsiniz. Ama Raporlama sheet'inin adına dokunmayın.

Sub raporlama()
Set shr = Sheets("Raporlama")
If shr.Cells(1, 2) = "" Then: MsgBox "Bir Semt seçiniz", vbCritical, "Dikkat": Exit Sub
shr.Range("A3:H1500").ClearContents
shr.Columns("M:M").ClearContents
shr.Cells(1, 13) = "Semt Verileri"
For i = 1 To Sheets.Count
[COLOR=red]    If Sheets(i).Name <> "Raporlama" Then[/COLOR]
       Set sh = Sheets(i)
       son = sh.Cells(65536, 6).End(xlUp).Row 'ARANACAK DEĞER
       For j = 3 To son
           sonr = shr.Cells(65536, 13).End(xlUp).Row
           shr.Cells(sonr + 1, 13) = sh.Cells(j, 6) 'ARANACAK DEĞER
       Next j
    End If
Next i
shr.Columns("N:N").ClearContents
shr.Cells(1, 14) = "Semt Listesi"
For i = 2 To sonr + 1
    x = Application.WorksheetFunction.CountIf(shr.Range("M2:M" & i), shr.Cells(i, 13))
       If x = 1 Then
          sons = shr.Cells(65536, 14).End(xlUp).Row
          shr.Cells(sons + 1, 14) = shr.Cells(i, 13)
       End If
Next i
shr.Columns("M:M").ClearContents
With shr.Cells(1, 2).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
     xlBetween, Formula1:="=$N$2:$N$" & sons + 1
    .IgnoreBlank = True
    .InCellDropdown = True
    .ErrorTitle = "SEMT İSMİNDE HATA"
    .ErrorMessage = "Lütfen uygun bir semt ismini listeden seçiniz"
    .ShowError = True
End With
For i = 1 To Sheets.Count
[COLOR=red]    If Sheets(i).Name <> "Raporlama" Then[/COLOR]
       Set sh = Sheets(i)
       son = sh.Cells(65536, 6).End(xlUp).Row 'ARANACAK DEĞER
       For j = 3 To son
           If sh.Cells(j, 6) = shr.Cells(1, 2) Then 'ARANACAK DEĞER
             sonn = shr.Cells(65536, 6).End(xlUp).Row 'ARANACAK DEĞER
             For k = 1 To 7 'SÜTUN SAYISI
                shr.Cells(sonn + 1, k) = sh.Cells(j, k)
             Next k
           End If
       Next j
    End If
Next i
End Sub

 

[mithrill74]

Sayın As3434 ve Sayın Fpc
ilginiz için teşekkür ederim.
belirtmiş olduğunuz kodlar sorunumu halletti.
iyi çalışmalar .))

 

[AS3434]

Sayın mithrill74

Sayın Fpc size kesin çözümü sunmuş.

Ayrıca
farklı sayfalardaki alt toplamları tek...

Başlığındaki mesajda bu konu ile ilgili ise, o başlığı sizce mahzuru yoksa silebilirmiyim?

 

[mithrill74]

Sayın AS3434

Diğer konu farklı bir çalışmam için gerekli

eğer onu da çözümleyebilirsem çok iyi olacak

teşekkür ederim .))