Aktar kodlarında değişiklik (birden fazla sütundan aktarma)

[Erdinç FIRTINA]

Değerli Forum üyeleri,

Siteden yararlanarak hazırlanan Ekteki dosyada, bir sayfadan diğer sayfaya veri aktaran kodlar bulunmaktadır. Sayfa2 D sütunundaki verileri belirlenen kritere göre sayfa1 de belirlenen satırlara aktarabiliyoruz.

Yapmak istediğim şudur.

D sütunundan aktarılan verilerin dışında, aynı kritere göre tablonun F, H, J vb. sütunundan veri aktarabilir miyim?

Yani D sütunundaki verileri aktardıktan sonra, F, H, J sütunundan da aynı veriyi aktarma işlemine, Sayfa1 deki aktarılan sütunun altından olacak şekilde devam edecek.

Dosyam ektedir. Yardımlarınız için şimdiden çok teşekkürler!!!

 

[Korhan Ayhan]

Selamlar,

Formunuzdaki butona ait kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub CommandButton1_Click()
    Dim ALAN As Range
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    SATIR = 2
    S1.Select
    [C2:E65536].ClearContents
    If TextBox1 = "" Then
    MsgBox "LÜTFEN ARAMAK İSTEDİĞİNİZ VERİYİ GİRİNİZ !", vbExclamation, "DİKKAT !"
    TextBox1.SetFocus
    Exit Sub
    End If
    For Each ALAN In S2.Range("D7:S31").SpecialCells(xlCellTypeConstants, 23)
    If Evaluate("=UPPER(""" & ALAN.Value & """)") = Evaluate("=UPPER(""" & TextBox1.Value & """)") Then
    S1.Cells(SATIR, 3) = S2.Cells(ALAN.Row, 3)
    S1.Cells(SATIR, 4) = ALAN.Value
    S1.Cells(SATIR, 5) = ALAN.Offset(0, 1).Value
    SATIR = SATIR + 1
    End If
    Next
    If SATIR > 2 Then
    MsgBox "AKTARMA İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
    Else
    MsgBox "ARANAN KAYIT BULUNAMAMIŞTIR.", vbCritical
    End If
End Sub

 

[Erdinç FIRTINA]

Sayin Korhan Ayhan,

Sİze Çok Çok TeŞekkÜr Ederİm. İyİ Kİ Varsiniz.