• DİKKAT

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

Bulunan verileri diğer sayfaya aktarma

K

kelkitli

Katılım
23 Şubat 2007
Mesajlar
1,212
Excel Vers. ve Dili
Excel2003
Değerli Dostlar Selamlar,
Sayfa1.Range("b2:b" & [A65536].End(3).Row).Find([A1], lookat:=xlWhole)
Genişletmek için tıkla ...
Şeklinde yaptığım arama sonucunda bulunan verileri diğer sayfaya döngü ile nasıl aktarırız.
 
Merhaba,

Aşağıdaki kodları kendi sayfanıza uyarlayınız.

Aranan değer Sayfa1 de E1 hücresindedir. E hücresindeki değeri A sütununda arar bulduklarını Sayfa2 ye aktarır.

Kod: 
Sub BulAktar()
Dim i As Long
Dim s1 As Worksheet, s2 As Worksheet
Dim c As Range
Dim Adres1 As Variant
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
Application.ScreenUpdating = False
s2.Range("A2:B65536").ClearContents
i = 1
With s1.Range("a:a")
    Set c = .Find([E1], LookIn:=xlValues)
    If Not c Is Nothing Then
        Adres1 = c.Address
        Do
            i = i + 1
            Range("A" & c.Row & ":B" & c.Row).Copy s2.Cells(i, "A")
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adres1
    End If
End With
End Sub
 

Ekli dosyalar

Necdet Yeşertener' Alıntı:
Merhaba,

Aşağıdaki kodları kendi sayfanıza uyarlayınız.

Aranan değer Sayfa1 de E1 hücresindedir. E hücresindeki değeri A sütununda arar bulduklarını Sayfa2 ye aktarır.

Kod: 
Sub BulAktar()
Dim i As Long
Dim s1 As Worksheet, s2 As Worksheet
Dim c As Range
Dim Adres1 As Variant
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
Application.ScreenUpdating = False
s2.Range("A2:B65536").ClearContents
i = 1
With s1.Range("a:a")
    Set c = .Find([E1], LookIn:=xlValues)
    If Not c Is Nothing Then
        Adres1 = c.Address
        Do
            i = i + 1
            Range("A" & c.Row & ":B" & c.Row).Copy s2.Cells(i, "A")
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adres1
    End If
End With
End Sub
Genişletmek için tıkla ...

merhaba hocam
bu 2 sayfa ve 2 sütunluk bilgileri aktarıyor
peki daha fazla sayfa ve sütun olursa ve bu sütunlardan istediğimizi aktarmak istersek ve sonuçta bir sütunda toplam almak istersek nasıl olacak?
 
masuk500' Alıntı:
merhaba hocam
bu 2 sayfa ve 2 sütunluk bilgileri aktarıyor
peki daha fazla sayfa ve sütun olursa ve bu sütunlardan istediğimizi aktarmak istersek ve sonuçta bir sütunda toplam almak istersek nasıl olacak?
Genişletmek için tıkla ...


Merhaba, Örnek dosya ile sorunuzu desteklerseniz yardımcı olacak arkadaşlar olacaktır.
 
merhaba
örnek dosya ektedir.sayfa 8,7,6,5 teki bilgileri sayfa 4 e hesap nosuna göre aktarmak istiyorum.yani hesap nosunu yazdığımda diğer sayfalardaki bilgilerin sayfa 4 de tarihe göre sıralanması.
 

Ekli dosyalar

Selamlar,

Sn. masuk500,

Sayfa4 'te bilgileri hangi formatta görmek istiyorsunuz belirtirseniz yardım almanız kolaylaşacaktır.
 
format derken kastettiğiniz nedir sayın korhan ayhan
ben sadece bütün sayfalarda hesap no standart ölçü olarak hesap noyu alırsak o hesap noya ait bilgilerin gelmesidir.
 
Selamlar,

Formattan kastım hangi bilgi hangi sütuna aktarılacak. Tablonuzun olması gereken halini eklemenizi kastetmiştim.
 
merhaba sayın korhan ayhan
dosyayı ekledim.burada firma bakiye sayfasındaki bigileri diğer sayfalardan bulup aktarmak istiyorum.firma bakiye sayfasındaki a2 hücresine hesap noyu yazınca firma adı ve aşağıdaki bilgiler gelsin.
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu "FİRMA BAKİYE" isimli sayfanızın kod bölümüne uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SAYFALAR As Variant, SÜTUN As Variant, BUL As Range, ADRES As String, SATIR As Long, X As Byte
    Dim İLK As Long, SAY As Long, ARTI As Long, SON_SATIR As Long
    Dim SON_TOPLAM_C As Double, SON_TOPLAM_D As Double, SON_TOPLAM_E As Double, SON_TOPLAM_F As Double
    Dim TOPLAM_C As Double, TOPLAM_D As Double, TOPLAM_E As Double, TOPLAM_F As Double
    Dim ADRES_C As String, ADRES_D As String, ADRES_E As String, ADRES_F As String
        
    If Intersect(Target, [A1]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
    
    SAYFALAR = Array("FATURAGİRİŞ", "ÖDEME ", "FİRMA FATURALARI", "TAHSİLAT")
    SÜTUN = Array("A:A", "B:B", "B:B", "B:B")
        
    Range("C1:F2").ClearContents
    Range("A6:F65536").ClearContents
    
    Set BUL = Sheets("FİRMALAR").Range("A:A").Find(Target, LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    Range("C1") = Sheets("FİRMALAR").Range("B" & BUL.Row) & " " & Sheets("FİRMALAR").Range("C" & BUL.Row)
    SATIR = 6
    
    For X = 0 To UBound(SAYFALAR)
    Set BUL = Sheets(SAYFALAR(X)).Range(SÜTUN(X)).Find(Target, LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
        If SAYFALAR(X) = "FATURAGİRİŞ" Then
        Cells(SATIR, 1) = Format(Sheets(SAYFALAR(X)).Cells(BUL.Row, 3), "dd.mm.yyyy")
        Cells(SATIR, 2) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 10)
        Cells(SATIR, 3) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 11)
        SATIR = SATIR + 1
        ElseIf SAYFALAR(X) = "ÖDEME " Then
        Cells(SATIR, 1) = Format(Sheets(SAYFALAR(X)).Cells(BUL.Row, 3), "dd.mm.yyyy")
        Cells(SATIR, 2) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 4)
        Cells(SATIR, 5) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 5)
        SATIR = SATIR + 1
        ElseIf SAYFALAR(X) = "FİRMA FATURALARI" Then
        Cells(SATIR, 1) = Format(Sheets(SAYFALAR(X)).Cells(BUL.Row, 3), "dd.mm.yyyy")
        Cells(SATIR, 2) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 4)
        Cells(SATIR, 4) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 5)
        SATIR = SATIR + 1
        ElseIf SAYFALAR(X) = "TAHSİLAT" Then
        Cells(SATIR, 1) = Format(Sheets(SAYFALAR(X)).Cells(BUL.Row, 3), "dd.mm.yyyy")
        Cells(SATIR, 2) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 4)
        Cells(SATIR, 6) = Sheets(SAYFALAR(X)).Cells(BUL.Row, 5)
        SATIR = SATIR + 1
        End If
    Set BUL = Sheets(SAYFALAR(X)).Range(SÜTUN(X)).FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
    Set BUL = Nothing
    Next
    
    Cells.EntireColumn.AutoFit
    
    If Range("A6") = "" Then
    
        MsgBox Target & " nolu hesaba ait veri bulunamamıştır !", vbExclamation: Exit Sub
        Else
        Application.ScreenUpdating = False
        
        ActiveWindow.View = 2
        
        SAY = ActiveSheet.HPageBreaks.Count
        İLK = 2
        ARTI = -1
        SON_TOPLAM_C = WorksheetFunction.Sum([C6:C65536])
        SON_TOPLAM_D = WorksheetFunction.Sum([D6:D65536])
        SON_TOPLAM_E = WorksheetFunction.Sum([E6:E65536])
        SON_TOPLAM_F = WorksheetFunction.Sum([F6:F65536])
        
        For X = 1 To SAY
            SATIR = ActiveSheet.HPageBreaks.Item(X).Location.Row - 1
            Rows(SATIR).Insert
            ADRES_C = "C" & İLK & ":C" & SATIR + ARTI
            ADRES_D = "D" & İLK & ":D" & SATIR + ARTI
            ADRES_E = "E" & İLK & ":E" & SATIR + ARTI
            ADRES_F = "F" & İLK & ":F" & SATIR + ARTI
            ARTI = 0
            İLK = SATIR
            TOPLAM_C = WorksheetFunction.Sum(Range(ADRES_C))
            TOPLAM_D = WorksheetFunction.Sum(Range(ADRES_D))
            TOPLAM_E = WorksheetFunction.Sum(Range(ADRES_E))
            TOPLAM_F = WorksheetFunction.Sum(Range(ADRES_F))
            Cells(SATIR, "B") = "TOPLAM :"
            Cells(SATIR, "C") = TOPLAM_C
            Cells(SATIR, "D") = TOPLAM_D
            Cells(SATIR, "E") = TOPLAM_E
            Cells(SATIR, "F") = TOPLAM_F
        Next
        
        SON_SATIR = [A65536].End(3).Row + 1
        Cells(SON_SATIR, "B") = "TOPLAM :"
        Cells(SON_SATIR, "C") = SON_TOPLAM_C
        Cells(SON_SATIR, "D") = SON_TOPLAM_D
        Cells(SON_SATIR, "E") = SON_TOPLAM_E
        Cells(SON_SATIR, "F") = SON_TOPLAM_F
        
        ActiveWindow.View = 1
        
        Application.ScreenUpdating = True
    
    End If
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
    Else
    
    Target.Select
    MsgBox "Hesap kodu bulunamamıştır !" & vbCrLf & "Lütfen kontrol ediniz !", vbCritical
    End If
End Sub
 
teşekkürler sayın korhan ayhan mesajınızı yeni gördüm.teşekkürler sorun çözüldü.
 
sayın korhan ayhan
sayfa sonlarında nasıl toplam alabiliriz?
örneğin firma bakiye sayfası 5 sayfa çıktı verdi hersayfanın sonunda nasıl toplam alabiliriz?
 
Selamlar,

Bu konuyla ilgili daha önce yanılmıyorsam Sn. Levent beyin yayınlamış olduğu kodları arşivime almıştım. Sizin dosyanıza uyarlayarak #11 nolu mesajımdaki kodu güncelledim. İncelermisiniz.
 
sayın korhan ayhan
çok teşekkür ederim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst