Makro ile tıklanan satırın kopyalandıktan sonra silinmesi

[u.L.a.s]

Merhabalar

Aşağıdaki gibi bir kod düzeneğim var.

Bu kod düzeneğinde bulunduğum sheette bir satırın A sütunundaki hücresine tıkladığımda bu hücrenin hizasındaki tüm satırı kopyalayıp Başka bir sheette bir sonraki boş satıra yapıştırıyor.

Buraya kadar ok. ben bundan sonrada bu tıkladığım hücredeki satırın komple delete etmek istiyorum. Bu koda ek bişey oluşturmanız hususunda yardımlarınızı rica ederim

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
son = Sheet12.Range("A65536").End(3).Row + 1
Range("B" & Target.Row).Copy
Sheet12.Range("A" & son).PasteSpecial
End If
Cancel = True
End Sub

 

[u.L.a.s]

Ek olarakta kopyalayıp diğer sheete yapıştırınca C sütunundan itibaren yapıştırıyor. yapıştırdığı satırda A hücresine bugünün tarihini yazsın

 

[ÖmerBey]

Kodunuza aşağıdaki satırları ilave edip deneyiniz.

Sheet12.Range("A" & son) = Date
Target.EntireRow.Delete

 

[u.L.a.s]

Merhabalar

ayrı bir konu açmadan bu konu altından sorayım istedim.

Bu kodda Çift tıklayarak yapılan bu işlemde. yani hücreye çift tıklayınca o satırı komple kesip sheet2 ye boş satır neresiyse yapıştırıyor

Ben bu işlemi mouse la çift tıklayarak değilde klavyeden atadığım bir tuş kombinasyonuyla gerçekleştirmek istiyorum. örneğin. diğer sheete yapıştırmak istediğim satırın üstüne gelip mouse la o satırda herhangi bir hücreye konumlandırıyorum. sonra atıyorum Ctrl+Alt+X tuşlarına basınca üstünde bulunduğum satır diğer tarafa cut and copy olsun istiyorum



Bilgi ve yardımlarınızı rica ederim

 

[Korhan Ayhan]

Çalışmanızın "ThisWorkBook" bölümüne aşağıdaki kodu uygulayın.

Private Sub Workbook_Activate()
    Application.OnKey "^%{x}", "AKTAR"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^%{x}", ""
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^%{x}", ""
End Sub

Boş bir modül ekleyin ve aşağıdaki kodu uygulayın. Kod içindeki satır ve sütun bilgilerini kendi çalışmanıza göre düzeltebilirsiniz.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S1.Select
    If ActiveCell.Column = 1 Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        Cells(ActiveCell.Row, 2).Copy
        S2.Range("B" & Son).PasteSpecial xlPasteAll
        S2.Range("A" & Son) = Date
        ActiveCell.EntireRow.Delete
    End If
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Son olarak dosyanızı kaydedin ve kapatıp tekrar açın.

CTRL+ALT+X tuşlarına basıp deneme yapın.

 

[u.L.a.s]

Üstadım

gönderdiğin kod içerisinde kırmızı renk ile işaretlediğim kod yüzünden sadece 2. hücrenin içeriğini kesip yapıştırıyor. bütün satırı komple taşımıyor. target row falan denedim ama yapamadım. bu hususla ilgili bilgi ve desteğini rica ederim

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S1.Select
    If ActiveCell.Column = 1 Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        [B][COLOR="Red"]Cells(ActiveCell.Row, 2).Copy[/COLOR][/B]
        S2.Range("B" & Son).PasteSpecial xlPasteAll
        S2.Range("A" & Son) = Date
        ActiveCell.EntireRow.Delete
    End If
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[Korhan Ayhan]

Sizin istediğiniz aktif satırı kopyala diğer sayfada son boş satıra yapıştır, daha sonra kopyalanan satırı sil ve diğer sayfada son satırdaki "A" sütununa günün tarihini yaz işlemi ise açıklamalarınızda bir çelişki var.

Son isteğinize göre uyarlanmış kod aşağıdaki gibi olmalıdır.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S1.Select
    If ActiveCell.Column = 1 Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        ActiveCell.EntireRow.Copy S2.Range("A" & Son)
        S2.Range("A" & Son) = Date
        ActiveCell.EntireRow.Delete
    End If
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[u.L.a.s]

Hocam eksik aktarıyor olabilirim mazur görün. Emeğinize sağlık bu haliyle tüm satırı Sheet2 ye aktarıyor. ilgili boş A hücresinede tarihi atıyor. kopyaladığı satırda ise A hücresindeki veriyi aktarmıyor fakat. A hücresindeki veri kalıyor. B hücresinden itibaren olan bilgileri taşıyor.

Ayrıca Sheet2 ye taşırken A hücresine date yazsın tamam ama Tüm satırı C hücresinden itibarn yapıştırsın.

 

[Korhan Ayhan]

Lütfen açıklamalı örnek dosya ekler misiniz?

 

[u.L.a.s]

Üstadım Dosya aşağıdaki linktedir.

Sheet1 de normal verilerim var. sheet2 ye ben seçtiğim satırdaki veriyi aynen sheet2 nasıl aktarılmışsa o şekilde aktarsın istiyorum.

http://www.dosya.tc/server7/38xjd5/cutcopy.rar.html

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    S1.Select
    If ActiveCell.Column = 1 Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        S1.Range("A" & ActiveCell.Row & ":M" & ActiveCell.Row).Copy S2.Range("C" & Son)
        S2.Range("A" & Son) = Date
        ActiveCell.EntireRow.Delete
    End If
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık çok teşekkür ederim