Farklı sayfalardaki verilerin tek sayfada toplanması

[kegat28]

Merhaba Arkadaşlar,
Daha önce yayınlandımı bilemiyorum ama acil ihtiyaçtan dolayı vede ilk kez konu açtım. Benim sorunun ekli dosyada 1,2,3 ve 4.sayfadaki verileri 5.sayfada toplanmasını istiyorum. 5.sayfa'nın a sütununda 141 girdiğimde 1,2,3 ve 4. sayfaların a sütünlarında 141 olan satırların listelenmesi veya 5.sayfanın a sütünunda TÜmü gibi bi ibare ile 1,2,3 ve 4. sayfalardaki bilgilerin listelenmesini istiyorum.

yardımlarınız için şimdiden teşekkürler..

 

[xxcell]

Ekteki dosyayı inceleyiniz.

 

[Orion1]

Merhaba.
Herhalde istediğiniz böyle bir şeydi.
Sayfa5'teki B1 hücresine aranacak No yu girin veya hepsi yazın.Butona basın.
Ekli dosyayı inceleyiniz.

Sub liste()
Dim i As Integer, j As Long, sat As Long
Sheets("Sayfa5").Select
Range("A2:G65536").ClearContents
If Range("B1").Value = "" Then
    MsgBox "B1 Hücresine aranacak No'yu giriniz.", vbCritical
    Range("B1").Select
    Exit Sub
End If
sat = 2
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Sayfa5" Then
        sonsat = Sheets(i).Cells(65536, "A").End(xlUp).Row
            For j = 1 To sonsat
                If sat = 65535 Then
                    MsgBox "Sayfa doldu . Ba&#351;ka kay&#305;t yapamazs&#305;n&#305;z..!!", vbCritical
                    Exit Sub
                End If
                If UCase(Replace(Replace(Range("B1").Value, "&#305;", "I"), "i", "&#304;")) = "HEPS&#304;" Then
                    Range("A" & sat & ":G" & sat).Value = Sheets(i).Range("A" & j & ":G" & j).Value
                    sat = sat + 1
                    ElseIf Range("B1").Value = Sheets(i).Cells(j, "A").Value Then
                        Range("A" & sat & ":G" & sat).Value = Sheets(i).Range("A" & j & ":G" & j).Value
                        sat = sat + 1
                End If
            Next j
    End If
Next i
MsgBox "L &#304; S T E L E M E   Y A P I L D I ..!!"
End Sub

 

[kegat28]

sayın XXCELL ve Sezar ilginiz için çok teşekkür ederim...

 

[Orion1]

Rica ederim.
İyi çalışmalar.

 

[kegat28]

Sayın XXCELL, Sayın Sezar,
her iki dosyada çok güzel olmuş, haddimi aşarak sizden iki ricada bulunmaka istiyorum.
1. 1,2,3 ve 4.sayfalara yeni billgiler girildiğinde veri yada 5,sayfaya listele yada veri aktar butanlarına basılmadan bilgilerin otomatik aktarımı yapılabilirmi?
2. veri yada bilgilerin listelendigi 5.sayfadaki bilgileri yada veri yada 5.sayfayı (1,2,3 ve 4.sayfa gitmeyecek) mail'e nasıl atabilirim?

tekrar çook teşekkür ederim.

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.
G sütununa veri girildikten sonra RAPOR sayfasına aktrma yapılıyor.
Mail atma konusunda ise bir bilgim yok.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sonsat As Long, adr1 As String, adr2 As String
On Error GoTo hata
    If ActiveSheet.Name = "RAPOR" Then Exit Sub
    If Target.Column <> 7 Then Exit Sub
    sonsat = Sheets("RAPOR").Cells(65536, "A").End(xlUp).Row
    If sonsat = 65535 Then
        MsgBox "Rapor sayfası doldu.Rapor sayfasına başka kayıt yapılamıyacaktır..!!", vbCritical
        Exit Sub
    End If
    adr1 = Range(Cells(Target.Row, "A"), Cells(Target.Row, "G")).Address
    adr2 = Range(Cells(sonsat + 1, "A"), Cells(sonsat + 1, "G")).Address
    Sheets("RAPOR").Range(adr2).Value = ActiveSheet.Range(adr1).Value
hata:
End Sub