Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Seçilen satırı Aktar ve Sil

ozkovlu29
ozkovlu29
Excel Cevaplanmış Soruları
1
985

Seçilen satırı Aktar ve Sil

#1
ozkovlu29
Aktif Üye
ozkovlu29
Bul
Aktif Üye
Adı Soyadı: Ba.... Çİ....
Yaşı: 38
Konum: Gümüşhane
Ofis Versiyonu: Ofis 2013 32 Bit
Son Oturumu: 29/08/2019,08:35
Yorumları: 92
Konuları: 39
Kayıt Tarihi: 09/08/2016
Teşekkür Puanı: 0
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
ozkovlu29
Aktif Üye
ozkovlu29
Bul
Aktif Üye
Adı Soyadı: Ba.... Çİ....
Yaşı: 38
Konum: Gümüşhane
Ofis Versiyonu: Ofis 2013 32 Bit
Son Oturumu: 29/08/2019,08:35
Yorumları: 92
Konuları: 39
Kayıt Tarihi: 09/08/2016
Teşekkür Puanı: 0
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
Task