hücrelerin yerlerini kurala göre değiştirmek

[finder]

merhaba haftada bir bütün çalışanların çalışma saatlerinin değiştiği liste ile uğraşıyorum. vardiya dönülen bir sistemimiz var. örneğin ali çftçi - mehmet yılmaz - veli başar'ın listedeki yerleri herbiri diğerinin alacak...

ilginiz için şimdiden teşekkürler.

 

[Skorpiyon]

Sayın finder,

Aşağıdaki kodları butonunuza ekleyin. Ben ilk grup için yaptım. Siz aynı mantık ile diğerlerini yapınız.


If [B4] = "Ali ÇİFTÇİ" Then
[B4] = "Mehmet ŞİMŞEK": [C4] = "Ali ÇİFTÇİ": [D4] = "Hasan GÜZEL"
Exit Sub
End If
If [B4] = "Hasan GÜZEL" Then
[B4] = "Ali ÇİFTÇİ": [C4] = "Hasan GÜZEL": [D4] = "Mehmet ŞİMŞEK"
Exit Sub
End If
If [B4] = "Mehmet ŞİMŞEK" Then
[B4] = "Hasan GÜZEL": [C4] = "Mehmet ŞİMŞEK": [D4] = "Ali ÇİFTÇİ"
Exit Sub
End If

Not : Kodun doğru çalışabilmesi için isimlerin büyük/küçük harf yazılış şekli önemlidir.

 

[Necdet]

Merhaba,

Benimde kodlarım şöyle :

Private Sub CommandButton1_Click()
Evet = Application.InputBox("İşleme Başlamak İstiyor Musunuz? E/H", "Nöbet Değiştirme", "H")
If Evet = False Or Evet = "H" Then
    MsgBox "Vazgeçildi....."
    Exit Sub
End If
Application.ScreenUpdating = False
For i = 4 To [B65536].End(3).Row
    If Cells(i, "B").Font.ColorIndex <> 3 Then
        Sakla = Cells(i, "D")
        Cells(i, "D") = Cells(i, "C")
        Cells(i, "C") = Cells(i, "B")
        Cells(i, "B") = Sakla
    End If
Next i
MsgBox "Vardiya Değişimi Tamamlanmıştır"
Application.ScreenUpdating = True
End Sub

 

[Orion1]

Alternatif;
Sayfa2'yi silmeyiniz.
Ekli dosayayı inceleyiniz.

Private Sub CommandButton1_Click()
Dim son_sat As Long
Sheets("Sayfa1").Select
son_sat = Cells(65536, "A").End(xlUp).Row + 4
If son_sat >= 65524 Then
    MsgBox "Sayfa Doldu Başka kayıt yapamazsınız..", vbCritical, "DİKKAT"
    Exit Sub
End If
Sheets("Sayfa2").Range("A14:D22").Copy
Range("A" & son_sat).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Sayfa2").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A" & son_sat).Select
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, "NÖBET"
End Sub

 

[finder]

arkadaşlar ilginiz için teşekkür ederim her problemim çözüldü, necdet arkadaşımın bulduğu çözüm işeme daha çok yarada. herkese tşk ederim