Soru Tarihe Göre Başka Sayfadan Veri Çekme

[TURKOLOG]

Herkese Merhaba
Ekteki dosyada kodla bur şeyler yapmaya çalıştım.

Görev listesi sayfası B sütununda olan tarihler Data sayfası B sayfasında da var . Aynı



Grup Yerleştirme İşlemine Başla butonuna tıklayınca
Görev listesi C4 I19 arasını temizleyecek
Sonra görev listesi sayfası B sütununda tarih yazan satırlar için data sayfası C D E F Sütunlarındaki yazili 1. Grup 2. Grup 3. Grup 4. Grup yazılanın üstündeki Gündüz Görevli Gece Görevli Geceden Çıktı istirahatli Gündüzden cıktı istirahati yazısını görev listesi sayfası F G H I Sütunlarına yazacak.

Olması gerektiği gibi olan şekli Görev Listesi sayfasına elle manüel yazdım.
Yardımcı olabilecek olan varsa çok sevinirim.

 

[TURKOLOG]

Kodda hatam var K sütununa yok yazıyor k sütununda bir işlem yapmiyorum.
Görev listesi B sütununda tarih varsa F4 DEN Başlayıp yazacak .F 6 dan başlıyor

Yardımcı olabilecek olan var mi

Sub Sayfaya_Aktar()

Dim sG As Worksheet, sD As Worksheet, gorev()

    Dim i&, ii&, krt$, w(1 To 1, 1 To 4)

    Set sG = Sheets("GÖREV LİSTESİ")

    Set sD = Sheets("DATA")

 

    sG.Range("F4:I19").ClearContents

    gorev = Array("Gündüz Çalışan", "Gece Çalışan", "Geceden Çıkıp İstirahatli", "Gündüzden Çıkıp İstirahatli")

    With CreateObject("Scripting.Dictionary")

 

        For i = 4 To sD.Cells(Rows.Count, "F").End(3).Row

            w(1, 1) = "": w(1, 2) = "": w(1, 3) = "": w(1, 4) = ""

            krt = sD.Cells(i, "B").Value

            For ii = 3 To 6

                Select Case sD.Cells(i, ii).Value

                    Case "1. GRUP": w(1, 1) = gorev(ii - 3)

                    Case "2. GRUP": w(1, 2) = gorev(ii - 3)

                    Case "3. GRUP": w(1, 3) = gorev(ii - 3)

                    Case "4. GRUP": w(1, 4) = gorev(ii - 3)

                End Select

            Next ii

            .Item(krt) = w

        Next i

 

        For i = 4 To sG.Cells(Rows.Count, "B").End(3).Row

            krt = sG.Cells(i, "B").Value

            If .exists(krt) Then sG.Cells(i, 6).Resize(i, 6).Value = .Item(krt)

        Next i

 

    End With

End Sub

 

[TURKOLOG]

Arkadaşlar kodda yardımcı olabilecek olan var mi acaba