sütuna göre veri çekmek

[igultekin2000]

iyi akşamlar; başka sayfalardan veri almayı sürekli kullanıyorum. her veride çekilmesi gereken sütünlar farklılık arzediyor. veri sayfasındaki sütünları sütün harfine bağlamak mümkünmüdür. Yani CALISMA sayfasındaki 9.cu satırdaki hücrelere veri doğrulama yapıp oradan seçtiğimiz harf (sütun) verilerini CALISMA sayfasına getirmek şansımız olursa çok verimli olacaktır.

Private Sub CommandButton2_Click()

Set sl = Sheets("CALISMA"): Set sk = Sheets("veri")
son = sl.Range("B" & Rows.Count).End(3).Row + 1
sat = 10
sl.Range("A10:F" & son).ClearContents
For i = 2 To sk.Range("A" & Rows.Count).End(3).Row
If sk.Cells(i, "a") > 0 Then
sl.Cells(sat, "A") = sk.Cells(i, "a")
sl.Cells(sat, "B") = sk.Cells(i, "b")
sl.Cells(sat, "C") = sk.Cells(i, "c")
sl.Cells(sat, "D") = sk.Cells(i, "d")
sl.Cells(sat, "E") = sk.Cells(i, "e")
sl.Cells(sat, "F") = sk.Cells(i, "f")

sat = sat + 1
End If
Next i
End Sub

bu kodlar verileri ilgili sayfaya çekiyorum.

 

[Ömer BARAN]

Merhaba.

Alt taraftan CALISMA isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağ taraftaki alana aşağıdaki kod blokunu yapıştırın.

İşlem, veri doğrulama'dan sütun adını seçtiğinizde gerçekleşir, düğme kullanılmasına gerek yok.
.

[B][COLOR="blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Intersect(Target, [A9:F9]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
sut = WorksheetFunction.Match(Target, [H10:H15], 0)
Set v = Sheets("veri")
If Cells(Rows.Count, Target.Column).End(3).Row > 9 Then _
    Range(Cells(10, Target.Column), Cells(Cells(Rows.Count, Target.Column).End(3).Row, Target.Column)).ClearContents
v.Range(v.Cells(2, sut), v.Cells(v.Cells(Rows.Count, sut).End(3).Row, sut)).Copy Target.Offset(1, 0)
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[igultekin2000]

sorunsuz çalışıyor

Merhaba.

Alt taraftan CALISMA isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağ taraftaki alana aşağıdaki kod blokunu yapıştırın.

İşlem, veri doğrulama'dan sütun adını seçtiğinizde gerçekleşir, düğme kullanılmasına gerek yok.
.

[B][COLOR="blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Intersect(Target, [A9:F9]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
sut = WorksheetFunction.Match(Target, [H10:H15], 0)
Set v = Sheets("veri")
If Cells(Rows.Count, Target.Column).End(3).Row > 9 Then _
    Range(Cells(10, Target.Column), Cells(Cells(Rows.Count, Target.Column).End(3).Row, Target.Column)).ClearContents
v.Range(v.Cells(2, sut), v.Cells(v.Cells(Rows.Count, sut).End(3).Row, sut)).Copy Target.Offset(1, 0)
[B][COLOR="Blue"]End Sub[/COLOR][/B]

Teşekkürler, işime yarayacak çok pratik bir kod olmuş. Elinize sağlık, İyi çalışmalar.

 

[Ömer BARAN]

Kolay gelsin.
.