Sayfalar Arası Veri Aktarımı

[yer06]

Saygıdeğer Arkadşlarım Excel dosyasında Sayfar arası istenilen verileri aktarımını nasıl sağlayabilirim Örnek olarak A1 hücresine bir veri yazacam veriyi yazıdğımda 2 sayfaya gidecek A1 ile A100000 arasındaki verilerle karşılatıracak benzer varsa 2 sayfadaki benzer numaranın c1 sutunundaki bilgiyi 1. sayfanın b1 sutununa yazacak aynısını 3. sayfada yapacak İstediğim hücrelerdeki bilgileri yazması sağlanacak Bu kodnuda yardımcı olursanız minnettar kalırım saygılarımla. İlgili dosya ektedir.

 

[Orion1]

Dosyanız ektedir.

Sub aktar()
Dim sh As Worksheet, sat As Long, k As Range, adr As String, sat2 As Long
Dim sut As Integer, isim As String, t As Long, var As Boolean
Sheets("liste").Select
sat2 = Cells(65536, "A").End(xlUp).Row
If sat2 < 1 Then
    MsgBox "A sütununa aranacak değeri giriniz" & vbLf & "Arama yapılmadı.", vbCritical, "UYARI"
    Range("A2").Select
    Exit Sub
End If
Application.ScreenUpdating = False
Range("B:IV").ClearContents
sut = 2
For Each sh In Worksheets
    isim = UCase(Replace(Replace(sh.Name, "ı", "I"), "i", "İ"))
    If Left(isim, 4) = "VERİ" Then
        sat = 2
        Cells(1, sut).Value = sh.Cells(1, "B").Value
        Cells(1, sut + 1).Value = sh.Cells(1, "C").Value
        Cells(1, sut + 2).Value = sh.Cells(1, "D").Value
        Cells(1, sut + 3).Value = sh.Cells(1, "E").Value
        For t = 2 To sat2
            Set k = sh.Range("A:A").Find(Cells(t, "A").Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
                adr = k.Address
                var = True
                Do
                    Cells(sat, sut).Value = k.Offset(0, 1).Value
                    Cells(sat, sut + 1).Value = k.Offset(0, 2).Value
                    Cells(sat, sut + 2).Value = k.Offset(0, 3).Value
                    Cells(sat, sut + 3).Value = k.Offset(0, 4).Value
                    Set k = sh.Range("A:A").FindNext(k)
                    sat = sat + 1
                Loop While Not k Is Nothing And k.Address <> adr
            End If
        Next t
        If var = True Then
            var = False: sut = sut + 4
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[yer06]

öncelikle bu ne hız çok tşk ederim ellerinize sağlık Nazar değmesin son soru olarak a1 hücresine yazdığım veri diğer sayfalarda var ise hangi hücrelerden verilerin geleceğini ben belirlemek istiyorum şimdiden tşk ederim.

 

[Orion1]

öncelikle bu ne hız çok tşk ederim ellerinize sağlık Nazar değmesin son soru olarak a1 hücresine yazdığım veri diğer sayfalarda var ise hangi hücrelerden verilerin geleceğini ben belirlemek istiyorum şimdiden tşk ederim.

bunu anlamadım.

 

[yer06]

sayın hocam yani ben aynı verilerden sadece A1 hücresine yazmayacam A1 den A50 ye kadar yazılı olan veri 2 Sayfaya gidecek A4 de kendini bulacak C4 istersem C5 deki veriyi 1 Sayfadaki B1 Hücresine Ve C1 hücresine yazdıracak yani yapmış olduğunuz örnekde sadece A1 hücresine ver yazdığımda aktar dediğimde aktrıyor oysaki a2 hücresinede veri yazacam benzeri varsa diğer sayfalardan bilgiyi çekecek saygılarımla

 

[Orion1]

sayın hocam yani ben aynı verilerden sadece A1 hücresine yazmayacam A1 den A50 ye kadar yazılı olan veri 2 Sayfaya gidecek A4 de kendini bulacak C4 istersem C5 deki veriyi 1 Sayfadaki B1 Hücresine Ve C1 hücresine yazdıracak yani yapmış olduğunuz örnekde sadece A1 hücresine ver yazdığımda aktar dediğimde aktrıyor oysaki a2 hücresinede veri yazacam benzeri varsa diğer sayfalardan bilgiyi çekecek saygılarımla

Örnek dosya ekleyip üzerinde açıklayınız.

 

[yer06]

buyrun hocam

 

[Orion1]

Peki sayfa2de E sütunda sayfa3 teki gibi veri olmayacakmı.Sonra ortaya çıkmasın buda vardı diye.

 

[yer06]

evet haklısınız olcak yani sayfa 2 ve sayfa3 deki 4 stündan veri almasını sağlayabilirmiyiz 4 sutun yeterli benim için tabi veri yoksa almayacak saygılarımla

 

[Orion1]

evet haklısınız olcak yani sayfa 2 ve sayfa3 deki 4 stündan veri almasını sağlayabilirmiyiz 4 sutun yeterli benim için tabi veri yoksa almayacak saygılarımla

o zaman arada bir sütun daha olması lazım.
Dosyanız son halini örnekleyerk yollarsanız doğru dosya üzerinden işlem yapalım.Bakın ben söylemeseydim ne olacaktı.Daha sonra diyecektiniz ki aaa ben sayfa2 dede e sütundan veri alaıcaktım..Bunu düzeltirmisin.Şimdi dosyanın son halini yolayıp örnekleyip dosyayı ekleyiniz.

 

[yer06]

sayın hocam listeyi ekde gönderdim şimdiden tşk ederim

 

[Orion1]

sayın hocam listeyi ekde gönderdim şimdiden tşk ederim

Dosyanız 2numaralı mesajda.

 

[yer06]

ne desem az gelir hocam ellerinize kollarınıza sağlık çok makbule geçti çok tşk ederim

 

[Orion1]

ne desem az gelir hocam ellerinize kollarınıza sağlık çok makbule geçti çok tşk ederim

Rica ederim.
İyi çalışmalar.