Operasyon tazminatı hazırlama

[pusula6]

Arkadaşlar merhaba operasyon tazminatı günlük çizelge hazırlamam gerekiyor. Personelin tarihe göre puantaj kısmında eğer 1 yazıyorsa isminin görev listesinde çıkmasını istiyorum dosya ektedir
yardımlarınız için teşekkür ederim

http://s6.dosya.tc/server5/xdjz1x/01.2016_BORDRO.xls.html

 

[Orion1]

Dosyanız linktedir.

DOSYAYI İNDİR

Sub puantaj1_59()
Dim sh As Worksheet, sat As Long, k As Byte, sut As Integer
sat = 9
Sheets("GÜN").Select
If Not IsDate(Range("D4").Value) Then
    MsgBox "D4 hücresinde tarih yok!" & vbLf & "İşlem iptal oldu!", vbCritical, "U Y A R I"
    Range("D4").Select
    Exit Sub
End If
Range("B9:B77").Value = Empty
Set sh = Sheets("PUANTAJ ")
For k = 4 To 34
    If sh.Cells(4, k).Value = Range("D4").Value Then
        sut = k
        Exit For
    End If
Next k
If sut = 0 Then
    MsgBox "D4 hücresindeki tarih bulunamadı!", vbCritical, "UYARI"
    Exit Sub
Else
    For i = 7 To 75
        If sh.Cells(i, sut).Value = 1 Then
            Cells(sat, "B").Value = sh.Cells(i, "B").Value
            sat = sat + 1
        End If
    Next i
End If
MsgBox "İşlem Tamamlandı.", vbOKOnly + vbInformation
    
End Sub

..

 

[pusula6]

Teşekkür ederim emeğinize sağlık tam istediğim gibi olmuş vermiş olduğunuz kodu ben yapacak olsaydım excelde nereye ekleyecektim excel bilgim çok az