• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

tüm sayfalardan veri bularak almak

M

muratozmenler

Katılım
9 Ocak 2009
Mesajlar
557
Excel Vers. ve Dili
2002 TÜRKÇE
2007 TÜRKÇE
2010 TÜRKÇE
2019 TÜRKÇE
selamlar...
sayfa 1 de r1 hücresinde yazılı ayı diğer sayfaların az sütununda bulup hangi ay yazılı ise bilgileri getirecek...
 

Ekli dosyalar

  • bul.xls
    bul.xls
    22 KB · Görüntüleme: 13
Dosyanız ektedir.:cool:
Kod: 
Sub aktar()
Dim k As Range, sat As Long, i As Long, sh As Worksheet
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sat = Cells(65536, "S").End(xlUp).Row + 1
For Each sh In Worksheets
    If IsNumeric(sh.Name) Then
        Set k = sh.Range("AZ:AZ").Find(Range("R1").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If sat >= 65533 Then
                MsgBox "Satır doldu.Kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
                Exit Sub
            End If
            Range("S" & sat & ":Z" & sat).Value = sh.Range("AZ" & k.Row & ":BH" & k.Row).Value
            sat = sat + 1
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Başarı ile tamamlandı." & vbLf & _
vbLf & "evrengizlen@hotmaial.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

J

Merhabalar

Bu Örnek Çalışmadaki Sayfa İsimleri 1 2 3 4 diye gidiyor Fakat Bu çalışmada Sayfa İsimlerini A B C D E Diye Değiştirirsek Makro hata Veriyor.Ben şöyle düşündüm

If ısalphabetic(sh.Name) Then fakat olmadı Kod nasıl değişirse Makro çalışır.
 
ANTALYA 01' Alıntı:
Merhabalar

Bu Örnek Çalışmadaki Sayfa İsimleri 1 2 3 4 diye gidiyor Fakat Bu çalışmada Sayfa İsimlerini A B C D E Diye Değiştirirsek Makro hata Veriyor.Ben şöyle düşündüm

If ısalphabetic(sh.Name) Then fakat olmadı Kod nasıl değişirse Makro çalışır.
Genişletmek için tıkla ...
Bu gibi durumlarda sayfa ismlerine diğerlerinden ayıran bir özellik eklemek gerek.
Mesela son karakterleri veya ilk karakteri 1 veya 2 neyse bir değer olabilir.Veya - içerebilir.Veya başka özel bir şey yapmak gerekir.
Tabii bunları sadece Bu arama işlemini yapacağımız sayfalara yapmamız lazım.Dier sayfalara sayfa ismi için bu özellikleri vermemek lazım.
Bu özellik katıldıktan sonra bu duruma göre kodlardaki düzenlemeyi yapabilirsiniz.:cool:
 
ANTALYA 01' Alıntı:
Merhabalar

Bu Örnek Çalışmadaki Sayfa İsimleri 1 2 3 4 diye gidiyor Fakat Bu çalışmada Sayfa İsimlerini A B C D E Diye Değiştirirsek Makro hata Veriyor.Ben şöyle düşündüm

If ısalphabetic(sh.Name) Then fakat olmadı Kod nasıl değişirse Makro çalışır.
Genişletmek için tıkla ...
Buyurun istediğiniz şartları sağlayan dosya ektedir.:cool:
Sayfa isimleri 1 karakter uzunluğunda olamlı ve sayısal bir değer ve tari olmamalıdır.:cool:Bu şartlar sağlanırsa Aktarma yapar.:cool:
Kod: 
Sub aktar()
Dim k As Range, sat As Long, i As Long, sh As Worksheet
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sat = Cells(65536, "S").End(xlUp).Row + 1
For Each sh In Worksheets
    If Not IsNumeric(sh.Name) And Not IsDate(sh.Name) And Len(sh.Name) = 1 Then
        Set k = sh.Range("AZ:AZ").Find(Range("R1").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If sat >= 65533 Then
                MsgBox "Satır doldu.Kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
                Exit Sub
            End If
            Range("S" & sat & ":Z" & sat).Value = sh.Range("AZ" & k.Row & ":BH" & k.Row).Value
            sat = sat + 1
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Başarı ile tamamlandı." & vbLf & _
vbLf & "evrengizlen@hotmaial.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Merhaba

Teşekkür ederim.Bu Kodları kullanarak ekteki çalışmaya uyarlamaya çalıştım ama olmadı.
RAPOR Sayfasında A1 hücresinde yazılı TARİH M den Başlayıp H Sayfasına kadar(Gizli Sayfalar Duracak bu sayfalarda herhangi bir işlem olmayacak) diğer sayfaların M sütununda bulup hangi tarih yazılı ise bilgileri getirecek bir makroya ihtiyacım var.
 

Ekli dosyalar

ANTALYA 01' Alıntı:
Merhaba

Teşekkür ederim.Bu Kodları kullanarak ekteki çalışmaya uyarlamaya çalıştım ama olmadı.
RAPOR Sayfasında A1 hücresinde yazılı TARİH M den Başlayıp H Sayfasına kadar(Gizli Sayfalar Duracak bu sayfalarda herhangi bir işlem olmayacak) diğer sayfaların M sütununda bulup hangi tarih yazılı ise bilgileri getirecek bir makroya ihtiyacım var.
Genişletmek için tıkla ...
Dosyanız ektedir.:cool:
Kod: 
Sub aktar()
Dim k As Range, sat As Long, i As Long, sh As Worksheet
Sheets("RAPOR").Select
Application.ScreenUpdating = False
Range("A2:M65536").ClearContents
sat = Cells(65536, "B").End(xlUp).Row + 1
For Each sh In Worksheets
    If Len(sh.Name) = 1 And Not IsNumeric(sh.Name) And Not IsDate(sh.Name) And sh.Visible = True Then
        Set k = sh.Range("M:M").Find(Range("A1").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If sat >= 65533 Then
                MsgBox "Satır doldu.Kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
                Exit Sub
            End If
            Range("B" & sat & ":J" & sat).Value = sh.Range("A" & k.Row & ":I" & k.Row).Value
            Cells(sat, "K").Value = sh.Cells(k.Row, "M").Value
            Cells(sat, "M").Value = sh.Name
            sat = sat + 1
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Başarı ile tamamlandı." & vbLf & _
vbLf & "evrengizlen@hotmaial.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

sayın evren bey benim için gerekli olan cevabı verdiğiniz için teşekkür ederim sayısalda olsa isimde olsa verileri bulup getiriyor bir sorun yok teşekkür ederim tekrardan....
 
muratozmenler' Alıntı:
sayın evren bey benim için gerekli olan cevabı verdiğiniz için teşekkür ederim sayısalda olsa isimde olsa verileri bulup getiriyor bir sorun yok teşekkür ederim tekrardan....
Genişletmek için tıkla ...
Sizin dosyanızdaki şart sayfalrın sayısal olmasıdır.Ve tek haneli olmasıdır.Bunun dışındaki sayfalardan veri almaz.
İyi çalışmalar.:cool:
 
h

Merhaba

Çok güzel olmuş fakat RAPOR Sayfasında A1 de Başka bir tarih seçildiğinde Tablodaki veriler silinse çünkü eski tarihli veriler tabloda kalıyor.birde RAPOR Sayfasında K sütununa M sütunundaki Tarihleride gelirse daha süper olacak.
 

Ekli dosyalar

ANTALYA 01' Alıntı:
Merhaba

Çok güzel olmuş fakat RAPOR Sayfasında A1 de Başka bir tarih seçildiğinde Tablodaki veriler silinse çünkü eski tarihli veriler tabloda kalıyor.birde RAPOR Sayfasında K sütununa M sütunundaki Tarihleride gelirse daha süper olacak.
Genişletmek için tıkla ...
Bu silinme konusunu soruyu sorarken ilk başta söylemeniz lazımdı.Söylemediğiniz için tahmine dayalı yazıldı kodlar.Bu yanlışı sadece siz değil soru soran tüm arkadaşlar yapıyorlar.Sorunuza bir bakınız bu konuda bir açıklama yapmışmısınız?
Bu durum düzeltildi.
2nci konuda düzeltildi.
Önceki mesajımdan düzenlediğim dosyayı indirebilirsiniz.:cool:
 
H

Merhabalar

İlginizden dolayı çok ama çok teşekkür ederim.Tam istediğim gibi olmuş.
 
Evren Gizlen' Alıntı:
Sizin dosyanızdaki şart sayfalrın sayısal olmasıdır.Ve tek haneli olmasıdır.Bunun dışındaki sayfalardan veri almaz.
İyi çalışmalar.:cool:
Genişletmek için tıkla ...

Sheets("BORDRO").Range("S3:Z500").ClearContents
Dim k As Range, sat As Long, i As Long, sh As Worksheet
Sheets("BORDRO").Select
Application.ScreenUpdating = False
sat = Cells(65536, "S").End(xlUp).Row + 2
For Each sh In Worksheets

Set k = sh.Range("AZ:AZ").Find(Range("K1").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
If sat >= 65533 Then
MsgBox "Satır doldu.Kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
Exit Sub
End If

Range("S" & sat & ":Z" & sat).Value = sh.Range("ba" & k.Row & ":BH" & k.Row).Value
sat = sat + 1
End If

Next
Application.ScreenUpdating = True
MsgBox "Aktarma Başarı ile tamamlandı." & vbLf & _
vbLf & "evrengizlen@hotmaial.com", vbOKOnly + vbInformation, "E V R E N"

SAYIN EVREN BEY BEN ARADAKİ ŞARTI KALDIRDIM BU ŞEKİL HER TÜRLÜ SAYFADAN VERİ ALIYOR AMA YANLIŞ YERİ KALDIRMADIM UMARIM SONRA SORUN OLMASIN ŞU AN SAYISALDA OLSAN İSİMDE OLSA ALIYOR..
 
Ayrıca evren bey 3 sayfa dışındaki sayfalardan veri almasını yani o üç sayfadan veri almasın nasıl bir ekleme yapmamız gerekir...
 
muratozmenler' Alıntı:
Ana,örnek,bordro
Genişletmek için tıkla ...
Aşağıdaki kodlar işinizi görür.:cool:
Kod: 
Sheets("BORDRO").Range("S3:Z500").ClearContents
Dim k As Range, sat As Long, i As Long, sh As Worksheet
Sheets("BORDRO").Select
Application.ScreenUpdating = False
sat = Cells(65536, "S").End(xlUp).Row + 2
For Each sh In Worksheets
    If UCase(sh.Name) <> "ANA" And UCase(sh.Name) <> "ÖRNEK" And UCase(sh.Name) <> "BORDRO" Then
        Set k = sh.Range("AZ:AZ").Find(Range("K1").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If sat >= 65533 Then
                MsgBox "Satır doldu.Kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
                Exit Sub
            End If
            Range("S" & sat & ":Z" & sat).Value = sh.Range("ba" & k.Row & ":BH" & k.Row).Value
            sat = sat + 1
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Başarı ile tamamlandı." & vbLf & _
vbLf & "evrengizlen@hotmaial.com", vbOKOnly + vbInformation, "E V R E N"
 
çok teşekkür ederim evren bey yine yardımıma siz koştunuz tekrar tekrar teşekkürler...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst