Başlığa göre veri çağırma.

[leumruk]

Selamlar...
Sayfa1'deki combobox aracılığıyla Sayfa2'de başlıklar halinde kayıtlı olan verileri sayfa1'in D9 nolu hücresine taşımak istiyorum.

NOT: Başlığık alınmayacak. Veri çağırıldığında çağırılan başlığın altındaki dolu olan tüm hücreler alınıp, Sayfa1 D9 nolu hücreye kopyalanacak.

Saygılar...

 

[Necdet]

Merhaba,

Axağıdaki kodların Sayfa1'in kod bölümünde olmalı.

Private Sub ComboBox1_Change()
If ComboBox1.Value = "" Then Exit Sub
Dim Son, i, j As Long
Set s2 = Sheets("Sayfa2")
Set r = Sheets("Sayfa2").Rows(1).Find(ComboBox1.Value, LookIn:=xlValues)
Son = s2.Cells(65536, r.Column).End(3).Row
j = 8
Application.ScreenUpdating = False
Range("D9:D65536").ClearContents
For i = 2 To Son
    j = j + 1
    Cells(j, "D") = s2.Cells(i, r.Column)
Next i
Application.ScreenUpdating = True
MsgBox "Aktarım İşi Tamamlanmıştır....", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

Private Sub Worksheet_Activate()
Son = Sheets("Sayfa2").[F1].End(xlToRight).Column
ComboBox1.Clear
For i = 6 To Son
    ComboBox1.AddItem (Sheets("Sayfa2").Cells(1, i))
Next i
End Sub

 

[leumruk]

Syn. Necdet hocam,
Çok teşekkür ederim.
İyi geceler...

Private Sub ComboBox2_Change()
If Combobox2.Value = "" Then Exit Sub
Dim Son, i, j As Long
Set s2 = Sheets("Kriter")
Set r = Sheets("Kriter").Rows(1).Find(Combobox2.Value, LookIn:=xlValues)
Son = s2.Cells(65536, r.Column).End(3).Row
j = 8
Application.ScreenUpdating = False
Range("D9:D43").ClearContents
For i = 2 To Son
    j = j + 1
    Cells(j, "D") = s2.Cells(i, r.Column)
Next i
Application.ScreenUpdating = True
MsgBox "Aktarım İşi Tamamlanmıştır....", vbOKOnly, "www.excel.web.tr"
[COLOR="Red"]Combobox2.Clear[/COLOR]
End Sub

Private Sub [COLOR="Red"]Combobox2_DropButtonClick[/COLOR]()
[COLOR="Lime"]'Combobox2.Clear[/COLOR]
Son = Sheets("Kriter").[F1].End(xlToRight).Column
For i = 6 To Son
    Combobox2.AddItem (Sheets("Kriter").Cells(1, i))
Next i
End Sub

Kodlarda ufak değişiklikler yaparak kendime uyarlamam gerekti...

Saygılar...

 

[Necdet]

Güle güle kullanınız sayım leumruk.