Satırlara tıklayarak verileri başka yere göndermek

[Blues]

Merhaba,

Hazırladığım bir dökümanda;
2,3,4,5,...15
17,18,...25
27,28...89 şeklinde satırlar ve A, B, C, D, E sütunlarında ilgili bilgiler mevcut.

Mesela;
A5 , B5 , C5 , D5 , E5 hücrelerinde bilgilerde, ben B5 hücresine tıkladığım zaman;
B5 , C5 ve D5 hücrelerindeki bilgiler diğer sayfadaki ilgili yerlerine yerleşsin istiyorum.

Bu sekilde seçim yaparak bilgileri diğer sayfalara gönderdikten sonra aynı listeden başka satırlardaki bilgileri de aynı şekilde diğer sayfaya göndermem gerekli. Mesela 5nci satırdaki bilgileri gönderdikten sonra 7nci sayfadaki bilgileri de göndermek istediğimde, bir önceki bilgileri altına yerleşmeli.

Bunu nasıl yapabileceğim konusunda yardımcı olursanız çok sevinirim.

Teşekkürler.

 

[Recep İpek]

Aşağıdaki linkleri inceleyebilirsiniz.

http://www.excel.web.tr/showthread.php?t=32920

http://www.excel.web.tr/showthread.php?t=31485

http://www.excel.web.tr/showthread.php?t=24201

 

[arol11]

Selamlar,
Sayın ripek aşağıda, verdiğiniz linklerden, sayın yeşertener in sanırım bir örneği var.
Benim için gerekli olan ise seçtiğim hücreleri çift tıklama ile SADECE VE HER ÇİFT TIKLADIĞIM, sayfa 2 de yazsın.ada uygun bir sayfa açmadan her tıklanan altalta sayfa 2 ye yazılmalı.Bunun için kodları nasıl düzenlemeli?Sayın yeşertener sorum size aslında.
iyi akşamlar.

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Intersect(Target, [A2:F65536]) Is Nothing Then Exit Sub
If ActiveCell.Row = 1 Then Exit Sub '-- 1. Satır Başlık olduğunu varsayarak işlem dışı bırakılmıştır
If ActiveCell.Value = "" Then Exit Sub
Set s2 = Worksheets("Sayfa2")
sonsat = s2.Cells(65536, "A").End(xlUp).Row
s2.Range("A" & sonsat + 1 & ":F" & sonsat + 1).Value = Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Value
s2.Columns("C:C").NumberFormat = "mm/dd/yyyy"
s2.Range("A2:F" & s2.[a65536].End(3).Row).Sort Key1:=s2.[C2], Order1:=xlAscending
MsgBox "Sayfa2'ye Kayıtlar Aktarılmıştır"
End Sub

 

[arol11]

selamlar sayın Sezar,
Tekrar aynı isimli sayfa açıp kopyalıyor.Seçip tıkladıklarımın hepsi altalta SAYFA 2 de kopyalanmalı.
Tamam ok. sayın sezar .İyi akşamlar.

 

[arol11]

Sezar bey,
siz kodları eklemediğinizden çalışmamıştı.
Birde şunu yapabilirmisiniz.aynı isimde olanları ve ayrıca renklendireceğim satırlarda aynı renkte olanları komple kopyalamak mümkün olamazmı?iki farklı çözüm bekliyorum sizden .
1-aynı isimler
2.aynı renkler

 

[Orion1]

selamlar sayın Sezar,
Tekrar aynı isimli sayfa açıp kopyalıyor.Seçip tıkladıklarımın hepsi altalta SAYFA 2 de kopyalanmalı.
Tamam ok. sayın sezar .İyi akşamlar.

yeni sayfa açıp kopyalama yapmıyor.sadece çift tıkladığınız satırı sayfa2'de alt alta yazıp sıralama yapıyor.Benim eklediğim dosyayı çalıştırdınızmı acaba.

 

[arol11]

evvet sizin dosyanızı çalıştırdım.fakat isimlere göre sayfa açıp buralara kopyalıyor.
Kodlarınızı eklediğimde çalıştı,sayfa 2 ye kopyaladı.Sizden ricam iki tanedir.
1.aynı renkli olanların tümünü . ve ayrıca
2.aynı isimli olanların tümünü.
kopyalatmak.
Nasıl olabilirmi?

 

[Orion1]

evvet sizin dosyanızı çalıştırdım.fakat isimlere göre sayfa açıp buralara kopyalıyor.
Kodlarınızı eklediğimde çalıştı,sayfa 2 ye kopyaladı.Sizden ricam iki tanedir.
1.aynı renkli olanların tümünü . ve ayrıca
2.aynı isimli olanların tümünü.
kopyalatmak.
Nasıl olabilirmi?

Merhaba.
Dosyanız Ekte.Butonlara basın kodlar çalışır.

Sub ayni_isimleri_kopyala()
Dim sonsat1 As Long, sonsat2 As Long, i As Long, sayac As Byte
Sheets("Sayfa1").Select
sonsat1 = Cells(65536, "A").End(xlUp).Row
If sonsat1 < 2 Then Exit Sub
For i = 2 To sonsat1
sonsat2 = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
Kriter1 = Cells(i, "A").Value
Kriter2 = Cells(i, "B").Value
Aralık1 = Range(Cells(2, 1), Cells(sonsat1, 1)).Address
Aralık2 = Range(Cells(2, 2), Cells(sonsat1, 2)).Address
bul = Evaluate("=SumProduct((" & Aralık1 & "=""" & Kriter1 & """)*(" & Aralık2 & "=""" & Kriter2 & """))")
    If bul > 1 Then
        If sonsat2 = 65535 Then
            MsgBox "S A Y F A   D O L D U   B A Ş K A   K A Y I T   Y A P A M A Z S I N I Z ..!!", vbCritical
            Exit Sub
        End If
        Sheets("Sayfa2").Range("A" & sonsat2 + 1 & ":F" & sonsat2 + 1).Value = _
        Range("A" & i & ":F" & i).Value
        sayac = 1
    End If
Next
If sayac = 1 Then
    MsgBox "A Y N İ   İ S İ M L E R D E   O L A N L A R   S A Y F A 2 ' Y E   A K T A R I L D I ..!!"
    Else
    MsgBox "A K T A R I L A C A K   A Y N İ   İ S İ M D E   K A Y I T   B U L U N A M A DI::!!", vbCritical
End If
End Sub

Sub Renkli_satırları_aktar()
Dim sonsat1 As Long, sonsat2 As Long, i As Long, sayac As Byte
Sheets("Sayfa1").Select
sonsat1 = Cells(65536, "A").End(xlUp).Row
If sonsat1 < 2 Then Exit Sub
For i = 2 To sonsat1
    sonsat2 = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
    If Range("A" & i).Interior.ColorIndex <> xlNone Then
                Sheets("Sayfa2").Range("A" & sonsat2 + 1 & ":F" & sonsat2 + 1).Value = _
        Range("A" & i & ":F" & i).Value
        sayac = 1
    End If
Next i
If sayac = 1 Then
    MsgBox "R E N K L İ    O L A N L A R   S A Y F A 2 ' Y E   A K T A R I L D I ..!!"
    Else
    MsgBox "A K T A R I L A C A K   R E N K L İ   K A Y I T   B U L U N A M A DI::!!", vbCritical
End If

End Sub

 

[arol11]

İyi akşamlar Sezar
Süpersin,çok sağol,varol.Excelin dert görmesin,Allah brütüslerden de seni korusun.

 

[Orion1]

İyi akşamlar Sezar
Süpersin,çok sağol,varol.Excelin dert görmesin,Allah brütüslerden de seni korusun.

Rica ederim.
İyi çalışmalar.

 

[arol11]

Sezar bey,
aynı isimli olanlar için bir box yapıp,bu box içinden seçtiklerimizi istediklerimizi kopyalatmak.
Rica etsem Sezar bey.Şimdiden çok teşekkür ediyorum.

 

[Orion1]

İstediğiniz dosya ektedir.
Listbox'a çift tıklıyorsunuz.O kişiye ait bilgiler sayfa2'ye akatarılıyor.

 

[arol11]

Çok teşekkürler sayın Sezar bey,bu tür kopyalamaları çok sık yapmak zorundayım.Bu yüzden sadece metin ifadelerini değil bazen "tarih" bazen "sayısal" verileride kopyalamam gerekli oluyor.Ekli dosyada bunu izah ettiğim örnekler var.
Yeni veri eklediğimde de "box" içinde süzülmüş olmadan hepsi yer almaktadır.

 

[Orion1]

Merhaba.
Ad soyadı tek bir sütun içinde kullanabilirseniz,Sanırım sorunun çözümü kolay olacaktır.Eğer o şekilde kullanabilirseniz.Son düzenlediğiniz örnek dosyayı yollayın ,onun üzerinde çalışayım.

 

[arol11]

Selamlar ve iyi akşamlar dilerim,
Basitçe üzerinde çalıştığımız örnek üzerinden bir örnek hazırladım.Sadece A sutununa gelecek veriler için metin-metin olmayan formatlar için düşünün ,B sutunundaki soyadlarını atlayın,kopyalama bir "box" içinden yapabilmeliyim.Aslında ,neyse dosyada belirttim.

 

[Orion1]

Merhaba.
Dosyayı istediğiniz şekilde hazırladım.
Şimdilik yalnızca adı'na göre rapor çıkarıyor.
Diğer şıklarıda hazırlayacağım.Şimdilik bu dosyayı (Ekli dosyayı)inceleyin.

 

[Orion1]

Dosyanız hazır.
Ekli dosyayı inceleyiniz.

 

[arol11]

Tammam,Tamda böyle .Okey sayın Sezar ,
fakat niçin aynı sayfaya kopyalattırdınız.Sayfa 2 ye kopya etmek için ben uğraştım olmadı.Sayfa 2 ye yada sayfa 3 e kopyalamak.Bunun için ne yapılabilir.

 

[Orion1]

Tammam,Tamda böyle .Okey sayın Sezar ,
fakat niçin aynı sayfaya kopyalattırdınız.Sayfa 2 ye kopya etmek için ben uğraştım olmadı.Sayfa 2 ye yada sayfa 3 e kopyalamak.Bunun için ne yapılabilir.

Hallederiz.