Çift Tıklama İle Son Satıra Kopyalama

[ormann]

Günaydın;
Ekli örnek dosyada Dikili Girişi sayfasında A12:M1500 hücre aralığındaki herhangi bir hücreyi çift tıkladığımda , tıkladığım satırdaki verileri son satıra kopyalamak istiyorum.Yardımcı olur musunuz?

http://dosya.co/xw2hr4a1n5nr/Örnek.xlsm.html

 

[alicimri]

Herhalde böyle bir şey istiyorsunuz. Aşağıdaki kodu ilgili sayfanın modülüne yapıştırıp, deneyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
satir = Target.Row
son = Range("a65536").End(3).Row
If Not Application.Intersect(Range("A12:M" & son), Range(Target.Address)) Is Nothing Then
Range("A" & satir & ":M" & satir).Cut
Range("A" & son + 1).Insert Shift:=xlDown
End If
End Sub

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Link:
http://www.dosya.tc/server12/qo7xlp/ormann-Ornek.zip.html

 

[alicimri]

Yukardaki kodu değiştirdim. Tetikleyici olayı yanlıştı ve kısıtlama yoktu.

 

[tugkan]

Merhaba,
Sayın @muygun en alt satıra değilde bir alt satıra kopyalamak istesek nasıl yapabiliriz? Alt satırı kaydıracak üstüne kaydetmeyecek.
Teşekkürler

 

[Tevfik_Kursun]

Merhaba Sayın Tughan,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    satir = Target.Row
    son = Range("a65536").End(3).Row
        If Not Application.Intersect(Range("A12:M" & son), Range(Target.Address)) Is Nothing Then
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("A" & satir & ":M" & satir).Copy
            Range("A" & satir + 1).Insert Shift:=xlDown
        End If
End Sub

sanırım bu işinizi görür.
İyi çalışmalar

 

[tugkan]

Sayın @Tevfik_Kursun cevap için teşekkür ederim.
Ama kodu çalıştırdığımda çift tıkladığım hücrenin içeriğini silerek satırı kopyalıyor. Satırı olduğu gibi kopyalamasını istiyorum.

 

[Tevfik_Kursun]

Merhaba,

            Range("A" & satir & ":M" & satir).Copy

bu kodu

            Range("satir & ":"satir).Copy

ile değiştirseniz yeterli sanırım
iyi çalışmalar

 

[tugkan]

Aşağıdaki hatayı veriyor.
Bi kaç yerini değiştirdim ama başaramadım.

 

[Tevfik_Kursun]

Merhaba,

            Range(satir & ":" & satir).Copy

böyle olmalıydı.
iyi çalışmalar

 

[tugkan]

Merhaba,

            Range(satir & ":" & satir).Copy

böyle olmalıydı.
iyi çalışmalar

Sizi uğraştırıyorum ama gene hücre içeriğini silerek kopyalıyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    satir = Target.Row
    son = Range("a65536").End(3).Row
        If Not Application.Intersect(Range("A12:M" & son), Range(Target.Address)) Is Nothing Then
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(satir & ":" & satir).Copy
            Range("A" & satir + 1).Insert Shift:=xlDown
        End If
End Sub

 

[Tevfik_Kursun]

burada deneyin lütfen

 

[tugkan]

Galiba sorun benim bilgisayar/excelde gene hücrenin içini siliyor. Sizi daha fazla meşgul etmeyim.
Vaktinizi alıp uğraştırdım kusura bakmayın.