Günlük İmza Çizelgeleri

[alperalper]

Arkadaşlar çalıştığım kurumda imza çizelgeleri çok fazla zaman alıyor ve ayrıca sürekli hata yapıyorum bende içerisine bir açıklama ekledim. Eğer bana bu konuda yardımcı olacak arkadaşlar olursa çok sevinirim.

 

[alperalper]

Arkadaşlar bu konuda bize yardım edecek kimsey yok mu??

 

[Ömer]

Merhaba,

Aktarım için, module kopyalayın..

Yalnız H sütununda kullandığınız birim adı ile sayfa adları aynı olmalıdır. Olmazsa hata mesajı alırsınız..

Sub Nöbet_Dağıt()
Dim Sayfa As Variant, i As Long, j As Long, S1 As Worksheet
Set S1 = Sheets("Liste")
For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "Liste" And Sheets(i).Name <> "Genel Durum" And _
    Sheets(i).Name <> "Döner" And Sheets(i).Name <> "Personel" Then
        Sheets(i).Range("C9:G65536").ClearContents
        Sheets(i).Range("C9:G65536").Interior.Pattern = xlSolid
    End If
Next i
For i = 3 To S1.[H65536].End(3).Row
    Sayfa = S1.Cells(i, "H")
    If Sheets(Sayfa).[C9] = "" Then
        j = 9
    Else
        j = Sheets(Sayfa).[C65536].End(3).Row + 1
    End If
    If S1.Cells(i, "B") <> "Pasif" Then
        Sheets(Sayfa).Cells(j, "C") = S1.Cells(i, "C")
        Sheets(Sayfa).Cells(j, "D") = S1.Cells(i, "D")
        Sheets(Sayfa).Cells(j, "G") = S1.Cells(i, "G")
    End If
    If S1.Cells(i, "G") <> "" And S1.Cells(i, "B") <> "Pasif" Then
        Sheets(Sayfa).Cells(j, "E").Interior.Pattern = xlGray25
        Sheets(Sayfa).Cells(j, "F").Interior.Pattern = xlGray25
    End If
Next
MsgBox "Akatarım tamalandı.", vbOKOnly + vbInformation, "[URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
End Sub

.

 

[alperalper]

üstad çok güzel olmuş tam istediğim gibi yalnız liste sayfasında b sütunundaki aktif pasifleri dikkate almıyor. Pasif olursa imza listesine hiç adını almasın. Eğer G sütununda veri varsa ilgili sayfada bulunan kutucukları siyahla kapatsın.

 

[Ömer]

#3 nolu mesajdaki kodları güncelledim, tekrar deneyiniz..

.