Sayfalar arası veri kontrolü

[kiziloguz]

Arkadaşlarım, Üstadlarım,

Şu anda bir vardiya listesi üzerinde çalışıyorum bu çalışma ile 400 kişinin gelişlerinin kontrolünü vardiya listeleri doğrultusunda yapmayı umuyorum.

Vardiya Listesi , Gelenler ve kontrol diye üç Sayfam var.

1- Vardiya sayfasında "G1" hücresine yazacağım tarihi Vardiya listesinde "F3:L3" aralağında bulup o sütundaki 1V,BYC,MYC yazan kişilerin 2nci sütundan 5 sütuna kadar olan bilgilerini Kontrol listesine kopyalasın ve yanına vardiyasını(1V,BYC,MYC) gibi yazsın.

2- Kontrol Sayfasından gelenler sayfasında sicil ve isimden önceki tarihve saati kontrol listesine yapıştırmasını istiyorum.

Not: Vardiya Listesi ekte 50 kişi kadar görünsede gerçek listem yaklaşık 450 kişi olacak.

Biraz karışık görünüyor ancak sizlerin yardım edebileceğinizi en azından başlamak için yol göstereceğinizi umuyorum.

Saygılarımla,

 

[Orion1]

Dosyanız ektedir.

Sub aktarvardiya59()
Dim sh As Worksheet, sat1 As Long, sat2 As Long, i As Long, k As Range
Sheets("Tüm Liste").Select
Set sh = Sheets("Kontrol")
sh.Range("A3:E" & Rows.Count).Clear
sat1 = Cells(Rows.Count, "D").End(xlUp).Row
sat2 = 3
If sat1 < 5 Then
    MsgBox "Tüm Liste sayfasında aktarılacak veri yok.!işlem iptal oldu!!", vbCritical, "U Y A R I"
    Exit Sub
End If
If Cells(1, "G").Value = "" Or Not IsDate(Cells(1, "G").Value) Then
    MsgBox "G1 Hüxcresinde Tarih yok.İşlem İptal oldu."
    Range("G1").Select
    Exit Sub
End If
Set k = Range("F3:L3").Find(Format(Range("G1").Value, "d mmm"), , xlValues, xlWhole)
If Not k Is Nothing Then
    sut = k.Column
    Else
    MsgBox "G1 hücresindeki Tarih F3:L3 aralığında bulunnamadı!!", vbCritical, "U Y A R I"
    Exit Sub
End If
Application.ScreenUpdating = False
For i = 5 To sat1
        Range("B" & i & ":E" & i).Copy sh.Range("A" & sat2)
        Cells(i, sut).Copy sh.Range("E" & sat2)
        sat2 = sat2 + 1
    Set k = Nothing
Next i
sh.Select
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName

End Sub

 

[Orion1]

kodlarda bir değişiklik yaptım.2 numaralı mesajdan tekrar indirebilirisiniz.

 

[kiziloguz]

Eline Emeğine Sağlık Orion1,

Üzerine eklemeler yaparak oluşacak dosya ile günlük en az 1 saatimi kurtarmış oldun