Seçilen satırı Aktar ve Sil

[ozkovlu]

Merhabalar;
Seçmiş olduğum satırı Farklı bir sekmeye aktarıp, Aktarılan satırı silmek istiyorum. Elimde aşağıdaki kod var, Fakat burada aktarmak istediğim sekmenin taranıp sondaki boş hücreye kayıt yapmasını;
Birde Renklendirmiş olduğum satır ve sütun ve hücreden;
Benim istediğim satır aralığı(B:T) ve sütunun da başlığının reklendirilmesini nasıl yapabilirim.
Dosya ektedir.
Saygılarımla....
http://s3.dosya.tc/server10/0yd2i2/aktarsil.zip.html

Sub AktarVeSil()
'
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Cut
MsgBox "C2" & "Personeli aktamak istediğinizden eminmisiniz? ", vbYesNoCancel
Sheets("MemSil").Select
ActiveWindow.SmallScroll Down:=-6
ActiveCell.Rows("1:1").EntireRow.Select
ActiveSheet.Paste
Sheets("Memur").Select
Selection.Delete Shift:=xlUp
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.EntireColumn.Interior.ColorIndex = 19 'Sütun Rengi
ActiveCell.EntireRow.Interior.ColorIndex = 17 ' Satır Rengi
ActiveCell.Cells.Interior.ColorIndex = 4 ' Hücre Rengi
End Sub

 

[ozkovlu]

Bu kod biraz işimi gördü gibi.

Sub AktarVeSil()

secim = ActiveCell.Value & ActiveCell.Offset(0, 1).Value 'Aktif hücrenin sağındakini seçer.
ActiveCell.Rows("1:1").EntireRow.Select
If MsgBox(secim & " Aktarıldıktan sonra Silinecektir. Onaylıyormusunuz?", vbOKCancel) = vbOK Then

Selection.Cut
Sheets("MemSil").Select
DEG = Cells(65536, "C").End(3).Row + 1
Cells(DEG, "C").Select
ActiveCell.Rows("1:1").EntireRow.Select
ActiveSheet.Paste
Sheets("Memur").Select
Selection.Delete Shift:=xlUp
Sheets("MemSil").Select
MsgBox "Aktarım işlemi başarılı bir şekilde gerçekleşmiştir..."
Else
MsgBox "Silme işlemi iptal edilmiştir"
End If



End Sub