AccessTr.neT

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....

Kod:
Sub AktarVeSil()

'

ActiveCell.Rows("1:1").EntireRow.Select

Selection.Cut

Sheets("MemSil").Select

ActiveWindow.SmallScroll Down:=-6

ActiveCell.Rows("1:1").EntireRow.Select

ActiveSheet.Paste

Sheets("Memur").Select

Selection.Delete Shift:=xlUp

End Sub

Kod:
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

Bu kod işimi gördü gibi.

Kod:
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

ozkovlu29

ozkovlu29