Veri Aktarma

[ormann]

Ekteki dosyamda A7:A16 hücrelerindeki rakamların her hangi birini tıkladığımda sarı renkli hücrelerdeki verilerin 1.keşif isimli dosyada belirtilen alanlara aktarılması ve yine A19:A28 hücrelerindeki rakamların her hangi birini tıkladığımda sarı renkli hücrelerdeki verilerin 2.keşif isimli dosyada belirtilen alanlara aktarabilir

 

[Huseyinkis]

Ekteki kodları Sayfa1 Kod Bolumune Yapıştırıp denermisin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("I7:U28")) Is Nothing Then Exit Sub
Set s1 = Sheets("HARCIRAH -MEMUR")
Set s2 = Sheets("1.KEŞİF")
Set s3 = Sheets("2.KEŞİF")
aaa = Target.Row
If IsNumeric(Cells(aaa, 4).Value) And aaa <= 16 Then
s2.Cells(2, 3).Value = s1.Cells(aaa, 3).Value
s2.Cells(3, 3).Value = s1.Cells(aaa, 4).Value
s2.Cells(4, 3).Value = s1.Cells(aaa, 5).Value
s2.Cells(5, 3).Value = s1.Cells(aaa, 6).Value
s2.Cells(6, 3).Value = s1.Cells(aaa, 7).Value
s2.Cells(7, 3).Value = s1.Cells(aaa, 8).Value
s2.Cells(8, 3).Value = s1.Cells(aaa, 9).Value
s2.Cells(9, 3).Value = s1.Cells(aaa, 10).Value
s2.Cells(10, 3).Value = s1.Cells(aaa, 11).Value
s2.Cells(11, 3).Value = s1.Cells(aaa, 12).Value
s2.Cells(12, 3).Value = s1.Cells(aaa, 13).Value
s2.Cells(13, 3).Value = s1.Cells(aaa, 15).Value
s2.Cells(14, 3).Value = s1.Cells(aaa, 20).Value
ElseIf IsNumeric(Cells(aaa, 4).Value) And aaa <= 28 Then
s3.Cells(2, 3).Value = s1.Cells(aaa, 3).Value
s3.Cells(3, 3).Value = s1.Cells(aaa, 4).Value
s3.Cells(4, 3).Value = s1.Cells(aaa, 5).Value
s3.Cells(5, 3).Value = s1.Cells(aaa, 6).Value
s3.Cells(6, 3).Value = s1.Cells(aaa, 7).Value
s3.Cells(7, 3).Value = s1.Cells(aaa, 8).Value
s3.Cells(8, 3).Value = s1.Cells(aaa, 9).Value
s3.Cells(9, 3).Value = s1.Cells(aaa, 10).Value
s3.Cells(10, 3).Value = s1.Cells(aaa, 11).Value
s3.Cells(11, 3).Value = s1.Cells(aaa, 12).Value
s3.Cells(12, 3).Value = s1.Cells(aaa, 13).Value
s3.Cells(13, 3).Value = s1.Cells(aaa, 15).Value
s3.Cells(14, 3).Value = s1.Cells(aaa, 20).Value
End If
End Sub

 

[ormann]

Sayın Hüseyin Bey ilginize teşekkür ederim.Benim istediğim a sutununda a7 ye bastığımda o satırdaki renkli alan istenilen sayfaya aktarılacak.Yine a8'e bastığımda o satırdaki renkli alanlar istenilen sayfaya aktarılacak.Bu işlem diğer sayılardada aynı şekilde olacak

 

[Huseyinkis]

Sayın Hüseyin Bey ilginize teşekkür ederim.Benim istediğim a sutununda a7 ye bastığımda o satırdaki renkli alan istenilen sayfaya aktarılacak.Yine a8'e bastığımda o satırdaki renkli alanlar istenilen sayfaya aktarılacak.Bu işlem diğer sayılardada aynı şekilde olacak

ilk gönderdiğim kodlardaki aşağıdaki kısmını değiştiriseniz istemiş olduğunuz işlemi yapar.

Eski Hali

If Intersect(Target, Range("I7:U28")) Is Nothing Then Exit Sub

Yeni hali

If Intersect(Target, Range("A7:A28")) Is Nothing Then Exit Sub