Sayfalara Dağıtım

[taseraydin]

Data sayfasında iki çeşit personel statüsü var
bu personellerin iki ayrı statüye göre sayfalara aktarılması

 

[Orion1]

Dosyanız ekteddir.

Sub aktar_59()
Dim sat1 As Long, sat2 As Long, sh As Worksheet, i As Long, sf As String
Dim k As Byte
Sheets("Data").Select
For Each sh In Worksheets
    If UCase(Right(sh.Name, 5)) = "STATÜ" Then
        sh.Range("A5:E65536").ClearContents
    End If
Next
sat1 = Cells(65536, "B").End(xlUp).Row
If sat1 < 5 Then
    MsgBox "DATA sayfasında veri yok.İşlem iptal oldu", vbCritical, "UYARI"
    Exit Sub
End If
Application.ScreenUpdating = False
For i = 5 To sat1
    sf = Cells(i, "C").Value & "." & Cells(4, "C").Value
    Set sh = Sheets(sf)
    sat2 = sh.Cells(65536, "B").End(xlUp).Row + 1
    sh.Range("A" & sat2 & ":D" & sat2).Value = Range("A" & i & ":D" & i).Value
    sh.Cells(sat2, "E").Value = sh.Cells(2, "F").Value * sh.Cells(sat2, "D").Value
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tammadır" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
    
End Sub

 

[taseraydin]

Teşekür

ilginize çok teşekür ederim.
mükemmel olmuş
dağıtımı yapılan saylardaki sıra numaraları anasayfadaki sıra numarası ile değilde kendi sayfasındaki sıralı sıra numarası olabilirmi

 

[Orion1]

ilginize çok teşekür ederim.
mükemmel olmuş
dağıtımı yapılan saylardaki sıra numaraları anasayfadaki sıra numarası ile değilde kendi sayfasındaki sıralı sıra numarası olabilirmi

İlk sayfada id no kulanmışsınız ya.
Bende zannettim ki id no olcak
id no başka bir şeydir.Sıra no başka bir şeydir.
İd no kullarak bir kayıt günellenebilir silinebilir her işelem yapılabilir.
Madem id no istemiyorsunuz istediğinzi sıra noyuda yaparım.

 

[Orion1]

istediğinzi gibi sıra no yaptım.
dosya ektedir..

Sub aktar_59()
Dim sat1 As Long, sat2 As Long, sh As Worksheet, i As Long, sf As String
Dim k As Byte
Sheets("Data").Select
For Each sh In Worksheets
    If UCase(Right(sh.Name, 5)) = "STATÜ" Then
        sh.Range("A5:E65536").ClearContents
    End If
Next
sat1 = Cells(65536, "B").End(xlUp).Row
If sat1 < 5 Then
    MsgBox "DATA sayfasında veri yok.İşlem iptal oldu", vbCritical, "UYARI"
    Exit Sub
End If
Application.ScreenUpdating = False
For i = 5 To sat1
    sf = Cells(i, "C").Value & "." & Cells(4, "C").Value
    Set sh = Sheets(sf)
    sat2 = sh.Cells(65536, "B").End(xlUp).Row + 1
    sh.Cells(sat2, "A").Value = sat2 - 4
    sh.Range("B" & sat2 & ":D" & sat2).Value = Range("B" & i & ":D" & i).Value
    sh.Cells(sat2, "E").Value = sh.Cells(2, "F").Value * sh.Cells(sat2, "D").Value
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tammadır" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
    
End Sub

 

[taseraydin]

çok,çok teşekür ederim emeğine eline sağlık

 

[Orion1]

çok,çok teşekür ederim emeğine eline sağlık

Rica ederim.
İyi çalışmalr.