Soru Ay Adlarına Göre Sayfalara Aktar

[sirkülasyon]

Hayırlı Akşamlar
Birincisi Personel Listesi sayfamda Görevli Olduğu Ay sütununda personelin görevli olduğu aylara "✓" işaret konulmuştur. Hangi aylara tik "✓" işareti konulmuş ise o satırdaki personel bilgilerini sayfalara aktarmak,
İkincisi de Sayfalarda personellere verilen ekders saatlerinin Bakiye Sayfasına toplamlarını aktarmak.
Bu konuda makro ya da fonksiyon tercih önemli değil, yardımınızı istiyorum.
Teşekkür ederim. Saygılarımla

 

[veyselemre]

Sub aylaraAktar()
    Dim sh(6 To 12), son(6 To 12), i, ii
    With Sheets("Personel Listesi")
        For i = 6 To 12
            Set sh(i) = Sheets(.Cells(2, i).Value)
            son(i) = sh(i).Cells(Rows.Count, 3).End(3).Row
        Next i
        For ii = 3 To .Cells(Rows.Count, 2).End(3).Row
            For i = 6 To 12
                If .Cells(ii, i).Value = "ü" Then
                    son(i) = son(i) + 1
                    sh(i).Cells(son(i), 3).Resize(, 3).Value = .Cells(ii, 2).Resize(, 3).Value
                End If
            Next i
        Next ii
    End With
End Sub

Sub toplamHesapla()
    Dim sh(6 To 12), son(6 To 12), i, ii, shB, ky, tSut
    Set shB = Sheets("Bakiye")
    With Sheets("Personel Listesi")
        For i = 6 To 12
            Set sh(i) = Sheets(.Cells(2, i).Value)
            son(i) = sh(i).Cells(Rows.Count, 3).End(3).Row
        Next i
    End With
    tSut = Array("AL", "AM", "AL", "AM", "AL", "AM", "AM")
    With CreateObject("Scripting.Dictionary")
        For i = 6 To 12
            For ii = 4 To son(i)
                If sh(i).Cells(ii, tSut(i - 6)).Value > 0 Then
                    ky = Trim(sh(i).Cells(ii, "D").Value)
                    .Item(ky) = .Item(ky) + sh(i).Cells(ii, tSut(i - 6)).Value
                End If
            Next ii
        Next i
        For i = 4 To shB.Cells(Rows.Count, 3).End(3).Row
            ky = Trim(shB.Cells(i, "D").Value)
            If .exists(ky) Then
                shB.Cells(i, "F").Value = .Item(ky)
            End If
        Next i
    End With
End Sub

 

[sirkülasyon]

Veysel Abi Teşekkür ederim. Sağ Olasın.
Aynı isimleri tekrar aktarım yapmaması için Önce sayfaların C,D,E sütunlarını temizlese sonra da mükerrer kontrolü yaparak aktarsa olur mu?