Atama Çevrim Programı

[Orion1]

Anlaştık üstadım. İyi geceler diliyorum.

İyi geceler.

 

[Orion1]

Dosyanız ektedir.

Sub aktar59()
Dim i As Long, sh As Worksheet, sonsat As Long, sat As Long
Sheets("ÇALIŞMA").Select
sonsat = Range("F1").Value
Set sh = Sheets("ÇEVRİM")
sat = 2
Application.Calculation = xlCalculationManual
For i = 2 To 32
    If Cells(i, "E").Value <> "TAMAM" Then
        sat = sat + 27
        sh.Cells(sat, "B").Value = Cells(i, "C").Value
    End If
Next i
Application.Calculation = xlCalculationAutomatic
sh.Select
Set sh = Nothing
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[carpediems]

Hocam çok heyecanlandım çünkü ilk defa bukadar yaklaştık sonuca.

Üstadım küçük problemler var. Dosyayı açıp makroları etkinleştir deyip butonu ilk tıkladığımda sıralama karışıyor, ikinci tıkladığımda ise normal bir şekilde çevrim sayfasına atamalar çıkıyor. Fakat burdada şöyle bir sorun ortaya çıkıyor. GÖKHAN GÖNÜL b29 a yazılıyor ki olması gerekende bu. B33 e baktığımızda GÖKHAN GÖNÜLÜN çevriminde VOLKAN DEMİR de yer alıyor. Böylelikle ÇALIŞMA sayfasında VOLKAN DEMİR in yanına (e sütunu) TAMAM yazısı çıkıyor fakat VOLKAN DEMİR ÇEVRİM sayfası b83 e tekrardan geliyor. Oysaki onun yanında TAMAM yazısı var. Yani her personel listede bir defa gelmeli.

Dosyanız ektedir.

Sub aktar59()
Dim i As Long, sh As Worksheet, sonsat As Long, sat As Long
Sheets("ÇALIŞMA").Select
sonsat = Range("F1").Value
Set sh = Sheets("ÇEVRİM")
sat = 2
Application.Calculation = xlCalculationManual
For i = 2 To 32
    If Cells(i, "E").Value <> "TAMAM" Then
        sat = sat + 27
        sh.Cells(sat, "B").Value = Cells(i, "C").Value
    End If
Next i
Application.Calculation = xlCalculationAutomatic
sh.Select
Set sh = Nothing
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Orion1]

ekli dosyadaki gibimi olacak.

Sub aktar59()
Dim i As Long, sh As Worksheet, sonsat As Long, sat As Long
Dim k As Range
Sheets("ÇALIŞMA").Select
sonsat = Range("F1").Value
Set sh = Sheets("ÇEVRİM")
sat = 2
'Application.Calculation = xlCalculationManual
For i = 2 To sonsat
    If Cells(i, "E").Value <> "TAMAM" Then
        sat = sat + 27
        sh.Cells(sat, "B").Value = Cells(i, "C").Value
    End If
Next i
'Application.Calculation = xlCalculationAutomatic
sh.Select
Set sh = Nothing
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[carpediems]

Sanırsam, kesinlikle, belki, muhakkak

Hocam çok çok teşekkür ederim. Tam anlamıyla istediğim şey olmuş.

Enteresanki biran önce işe gidesim geldi. Hocam bizim işyerinde, usb, cd dvd, internet falan yok. Küçük hd siz bilgisayarlar kullanıyoruz. Ben sizin kodu çıktı alıp oradaki excelime yazacağım. Sayfa isim, sütun vs ufak sıkıntılar olursa tekrar kapınızı çalmak isterim. Malum vb konusunda eksilerden sıfıra yaklaşmaya çalışıyorum

Tekrardan çok teşekkür ediyorum. İyi akşamlar diliyorum.

ekli dosyadaki gibimi olacak.

Sub aktar59()
Dim i As Long, sh As Worksheet, sonsat As Long, sat As Long
Dim k As Range
Sheets("ÇALIŞMA").Select
sonsat = Range("F1").Value
Set sh = Sheets("ÇEVRİM")
sat = 2
'Application.Calculation = xlCalculationManual
For i = 2 To sonsat
    If Cells(i, "E").Value <> "TAMAM" Then
        sat = sat + 27
        sh.Cells(sat, "B").Value = Cells(i, "C").Value
    End If
Next i
'Application.Calculation = xlCalculationAutomatic
sh.Select
Set sh = Nothing
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Orion1]

İyi akşamlar.

 

[carpediems]

Merhaba. Hocam iş yerinde sistemi uygulayabildim. Tekrardan çok teşekkür ediyorum. İyi akşamlar diliyorum.

İyi akşamlar.