Makroya İlave (Seçilen Öğüne Göre)

[1Al2Ver]

Merhaba,

"Modül1" de kayıtlı kod, şu haliyle tek sayfadan (YEMEK_LİSTESİ_ÖĞLE) "F5:F14" aralığına veri almaktadır,

Ben, "RAPOR" sayfasında konuşlu ListBox'tan yapılan seçime göre, veri almak istiyorum,

ListBox'ta şu an 5 seçenek mevcuttur, belki 1 seçenek daha ekleyeceğim,

Mevcut makronun, seçenek dahilinde işlem yapması için gereken kodu rica ediyorum,

Teşekkür ederim.

Sub Yemek_Al()

Set rp = Sheets("RAPOR"): Set ylo = Sheets("YEMEK_LİSTESİ_ÖĞLE")
rp.Range("F5:G14").ClearContents
If rp.[G1] = "" Or WorksheetFunction.CountIf(ylo.Range("B3:B33"), rp.[G1]) = 0 Then Exit Sub
satır = WorksheetFunction.Match(rp.[G1], ylo.Range("B3:B33"), 0) + 2
sonsütun = 11 - WorksheetFunction.CountBlank(ylo.Range(ylo.Cells(satır, "C"), ylo.Cells(satır, "L")))
If sütun = 2 Then Exit Sub
For sut = 3 To sonsütun
rp.Cells(sut + 2, "F") = ylo.Cells(satır, sut)
Next
End Sub

 

[Ömer]

Merhaba

Veriler sayfası M sütunundaki öğünlerin yanına ( N sütununa) hangi öğün hangi sayfadan veri alacaksa yazıp aşağıdaki kodları kullanın.
Kod yapınızı değiştirmedim, sadece istediğiniz ilaveyi yaptım.

Sub Yemek_Al()

Set rp = Sheets("RAPOR")

'ilave1 *********
Set c = Sheets("VERİLER").[M8:M12].Find(rp.[E2], , xlValues, xlWhole)
If Not c Is Nothing Then
    syf = Sheets("VERİLER").Cells(c.Row, "N")
End If
'ilave1 bitti***

Set ylo = Sheets(syf) ' ilave2: syf ile ylo tanımındaki sayfa adı değişkene atandı

rp.Range("F5:G14").ClearContents

If rp.[G1] = "" Or WorksheetFunction.CountIf(ylo.Range("B3:B33"), rp.[G1]) = 0 Then Exit Sub

satır = WorksheetFunction.Match(rp.[G1], ylo.Range("B3:B33"), 0) + 2

sonsütun = 11 - WorksheetFunction.CountBlank(ylo.Range(ylo.Cells(satır, "C"), ylo.Cells(satır, "L")))

If sütun = 2 Then Exit Sub

For sut = 3 To sonsütun

rp.Cells(sut + 2, "F") = ylo.Cells(satır, sut)

Next

End Sub

 

[1Al2Ver]

Sayın Ömer merhaba,

İlginiz, açıklamalarınız ve çözüm için çok teşekkür ederim,

Dosya, müthiş bir pratiklik kazandı,

Ben de naçizane bir şeyler öğrenmeye başladım, sağ olun.

Saygılarımla.

 

[Ömer]

Rica ederim, yardımcı olabiliyorsak ne mutlu.