Veri aktarma

[Ahmet Sami]

Sizden istediğim yardım, D5 ile D10 aralığında bulunan verilerden herhangi birini veya bir kaçını seçmek sureti ile HEDEFKAYIT sayfasından seçtiğim verilerin H5 : P aralığında aktarılmasıni istiyorum.
Örnek: 1- ALKAN LTD. ŞTİ. yi seçersem bu şirkete ait tüm bilgiler HEDEFKAYIT sayfasından aktarılsın.
Örnek: 2- ALKAN LTD ŞTİ. ve BİLGİSAYAR'ı seçersem ALKAN LTD ŞTİ. ye ait BİLGİSYAR' lar gelsin gibi vs...

Birçok veri aktarma örneklerine baktım ancak istediğim aktarma örneğini bulamadım. O yüzden yardımlarınıza ihtiyacım var şimdiden teşekkür ederim.

 

[ÖmerBey]

Merhaba,
Hedef sayfasının kod bölümüne aşağıdaki kodu kopyalayıp deneyiniz.

Private Sub ComboBox1_Change()
veri_al
End Sub

Private Sub ComboBox2_Change()
veri_al
End Sub

Private Sub ComboBox3_Change()
veri_al
End Sub

Private Sub ComboBox4_Change()
veri_al
End Sub

Private Sub ComboBox5_Change()
veri_al
End Sub

Private Sub ComboBox6_Change()
veri_al
End Sub

Private Sub veri_al()
With Sayfa2
    s = .Cells(.Rows.Count, 1).End(3).Row
    If s < 2 Then Exit Sub
    dz = .Range("A2:I" & s).Value
End With
ad = IIf(Me.ComboBox5 = "", "*", Me.ComboBox5)
birim = IIf(Me.ComboBox1 = "", "*", Me.ComboBox1)
detay = IIf(Me.ComboBox2 = "", "*", Me.ComboBox2)
nevi = IIf(Me.ComboBox3 = "", "*", Me.ComboBox3)
il = IIf(Me.ComboBox4 = "", "*", Me.ComboBox4)
yil = IIf(Me.ComboBox6 = "", "*", Me.ComboBox6)
ReDim dz1(1 To UBound(dz), 1 To UBound(dz, 2))
For a = LBound(dz) To UBound(dz)
    If dz(a, 2) Like ad And dz(a, 3) Like birim And dz(a, 4) Like detay And _
        dz(a, 5) Like nevi And dz(a, 6) Like il And dz(a, 7) Like yil Then
        x = x + 1
        For b = LBound(dz, 2) To UBound(dz, 2)
            dz1(x, b) = dz(a, b)
        Next
    End If
Next
Me.Range("H5").Resize(UBound(dz1), UBound(dz1, 2)).Value = dz1
End Sub

 

[Ahmet Sami]

Ömer bey ilginizden dolayı teşekkür ederim. Sizden bir ricam direkt olarak aktarması yerine bir butona bağlı olarak aktarsa olur mu.

 

[Ahmet Sami]

Ayrıca Sayfa adını tanımlayabilir miyiz. Yoksa Başka sayfalarda var oralardan veri çekiyor. Yani Sayfa adını HEDEF KAYIT olarak yapalbilirmiyiz.

 

[ÖmerBey]

Tekrar merhaba,
Aşağıdaki kodu boş bir modüle kopyalayıp butona atayarak kullanabilirsiniz.

Sub veri_al()
With Sayfa2 'HEDEF KAYIT sayfasının vba ismi
    s = .Cells(.Rows.Count, 1).End(3).Row
    If s < 2 Then Exit Sub
    dz = .Range("A2:I" & s).Value
End With

With Sayfa1 'HEDEF sayfasının vba ismi
    ad = IIf(.ComboBox5 = "", "*", .ComboBox5)
    birim = IIf(.ComboBox1 = "", "*", .ComboBox1)
    detay = IIf(.ComboBox2 = "", "*", .ComboBox2)
    nevi = IIf(.ComboBox3 = "", "*", .ComboBox3)
    il = IIf(.ComboBox4 = "", "*", .ComboBox4)
    yil = IIf(.ComboBox6 = "", "*", .ComboBox6)
    ReDim dz1(1 To UBound(dz), 1 To UBound(dz, 2))
    For a = LBound(dz) To UBound(dz)
        If dz(a, 2) Like ad And dz(a, 3) Like birim And dz(a, 4) Like detay And _
            dz(a, 5) Like nevi And dz(a, 6) Like il And dz(a, 7) Like yil Then
            x = x + 1
            For b = LBound(dz, 2) To UBound(dz, 2)
                dz1(x, b) = dz(a, b)
            Next
        End If
    Next
    .Range("H5").Resize(UBound(dz1), UBound(dz1, 2)).Value = dz1
End With
End Sub

 

[Ahmet Sami]

Ömer Bey, çok teşekkür ederim elinize yüreğinize sağlık.

 

[ÖmerBey]

Rica ederim Ahmet Sami Bey,
İyi çalışmalar dilerim...