Bordro Sayfasındaki Verileri Liste Sayfasına Aktarmak İstiyoruz

[mustafa]

Merhabalar,
Programda o ay içerisinde göreve giden personele yolluk yapılacak.
Ay içerisinde aynı personel birden fazla gün göreve gitmiş olabiliyor.
Örneğin ayın 1'inde dört personel göreve gitmiş, ayın 2'sinde 5 personel göreve gitmiş, biz ayın 1'i için bordro yapacağız ve o bordroda kimler varsa aktar butonuna tıkladığımızda veriler Liste sayfasında tarihe göre isimlerin karşısına aktarılacak. Ayın 2'si için bordro yaptığımızda o bordroda kimler varsa Liste sayfasında o tarihe göre isimlerin olduğu satıra veriler aktarılacak.
Yani bordro sayfasındaki Q1 satırındaki tarihe göre Liste sayfasında o tarihteki isimlerin olduğu satırlara veri aktarılacak.

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz. Aktarımda hata olan hücreler kırmızıya boyanır:

Sub aktar()
Set s1 = Sheets("Bordro")
Set s2 = Sheets("Liste")
son = s2.Cells(Rows.Count, "C").End(3).Row
For i = 8 To 27
    If s1.Cells(i, "C") <> "" Then
        If s1.Cells(i, "F") = "" Then
            s1.Cells(i, "F").Interior.Color = vbRed
            GoTo 10
        End If
        If WorksheetFunction.CountIf(s2.Range("C3:C" & son), s1.Cells(i, "C")) = 0 Then
            s2.Cells(son + 1, "C") = s1.Cells(i, "C")
            son = son + 1
        End If
       
        sat = WorksheetFunction.Match(s1.Cells(i, "C"), s2.Range("C1:C" & son), 0)
        yil = Mid(s1.Cells(i, "F"), 7, 4) * 1
        ay = Mid(s1.Cells(i, "F"), 4, 2) * 1
        gun = Left(s1.Cells(i, "F"), 2) * 1
        tarih = DateSerial(yil, ay, gun)
        If s2.[E3] = "" Then
            s1.Cells(i, "F").Interior.Color = vbRed
        ElseIf ay = Month(s2.[E3]) Then
            sut = ay + 4
            If s1.Cells(i, "Q") = "" Then
                s1.Cells(i, "Q").Interior.Color = vbRed
            Else
                s2.Cells(sat, sut) = s1.Cells(i, "Q")
                s1.Cells(i, "C").Interior.Color = xlNone
                s1.Cells(i, "F").Interior.Color = xlNone
                s1.Cells(i, "Q").Interior.Color = xlNone
            End If
        End If
    End If
10:
Next
End Sub