Soru Çift tık ile alta aktar

[sirkülasyon]

Hayırlı Sabahlar
Ekli dosyamda C24 : C39 arasında yer alan herhangi bir satıra çift tık yapıldığı zaman satırı silecek C42 :C57 arasında ki satıra alt alta aktaracak. Sildiği satırı bir üste kaydıracak koda ihtiyacımız var. Rica etsem yardımcı olabilir misiniz?

 

[Necdet]

Merhaba,

Sorunuzu tam olarak anlamamakla birlikte birşeyler yapmaya çalıştım.
C:E hücrelerini kopyalar ve bulunduğu satırı siler. (B sütunundaki sıra numaralarına dokunmaz.)

Bu sütunlarda birleştirilmiş hücre olmamalı. Kodlar ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Row < 24 Or Target.Row > 39 Then Exit Sub
    
    Dim i   As Long
    
    i = Cells(Rows.Count, "C").End(3).Row + 1
    If i < 42 Then i = 42
    
    Range(Cells(Target.Row, "C"), Cells(Target.Row, "E")).Copy Range("C" & i)
    Range(Cells(Target.Row, "C"), Cells(Target.Row, "E")).ClearContents
    
    Range("C24:E39").Sort Key1:=[C1]
    
End Sub

 

[usubaykan]

Alternatif olarak;

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim bul As Range

If Intersect(Target, Range("C24:C39")) Is Nothing Then Exit Sub

Range(Cells(Target.Row, "B"), Cells(Target.Row, "E")).Copy

Set bul = Range("B" & Target.Row + 1 & ":B65536").Find(What:=Cells(Target.Row, "B"), LookAt:=xlWhole)

Range(Cells(bul.Row, "B"), Cells(bul.Row, "E")).PasteSpecial
Rows(Target.Row).Delete

End Sub

ilgili sayfanın kod bölümüne kodu deneyiniz.

 

[sirkülasyon]

Necdet abi. Sözüme tercüman olan bir kod paylaşımı yapmışsınız. Teşekkür ederim. Sağ ol.
Usubaykan kardeşim şişede teşekkür ediyorum. Yardımınızı esirgemediginiz için.
Saygılarımla.