Soru Kontrollü Veri Kopyalama

[TURKOLOG]

Merhaba arkadaşlar
Dosyamda Görev Listesi ve Data sayfaları var.
Bir örnek yaptım ben
Görev listesinde yazılan tarihler ait veriler daha sayfasından bulunup Gorev listesine yazılacak.
Yardımcı olabilecek olan varsa çok sevinirim.
Harici Dosya Silinebilir.

 

[veyselemre]

Sub test()
    Dim sG As Worksheet, sD As Worksheet, gorev()
    Dim i&, ii&, krt$, w(1 To 1, 1 To 3)
    Set sG = Sheets("GÖREV LİSTESİ")
    Set sD = Sheets("DATA")

    sG.Range("C4:E11").ClearContents
    gorev = Array("Gündüz", "Gece", "İstirahatli")
    With CreateObject("Scripting.Dictionary")

        For i = 3 To sD.Cells(Rows.Count, "E").End(3).Row
            w(1, 1) = "": w(1, 2) = "": w(1, 3) = ""
            krt = sD.Cells(i, "B").Value
            For ii = 3 To 5
                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)
                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, 3).Resize(, 3).Value = .Item(krt)
        Next i

    End With

End Sub

 

[TURKOLOG]

Hocam emeğinize sağlık kod çalıştı. Çok teşekkür ederim.