Skip to main content

AccessTr.neT


Seçilen satırı Aktar ve Sil

Seçilen satırı Aktar ve Sil

#1
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

.zip aktarsil.zip (Dosya Boyutu: 24,05 KB | İndirme Sayısı: 14)
Cevapla
#2
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

Son Düzenleme: 11/02/2017, 10:45, Düzenleyen: ozkovlu29.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da