Copy a Row from one sheet to another using double click

[Bassplayer]

Hello!

I´m having problem in creating a code to copy a row (values are variable) from one sheet to another sheet. I want only to move the rows within the interval 3 to 10. These cells are all in Column C. In the destination sheet the value should be inserted in the first blank row but that I can manage. The code I´ve made so far is:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Integer
Dim r As Integer
c = Target.Column
r = Target.Row
If Target.Column <> 3 And Target.Row < 3 And Target.Row > 10 Then Exit Sub
Sheets("Folha1").Select
Rows(r & ":" & r).Select
Selection.Cut
Sheets("Folha2").Select
Rows("8:8").Select
Selection.Insert Shift:=xlDown
Sheets("Folha1").Select
End Sub


Can please somebody help me? Thanks in advance!

Best regards,
Ricardo

 

[Momentman]

I do something like this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)     Dim wks As Worksheet     Dim lastrow As Integer     Set wks = Worksheets("folha2")          If wks.Range("A1").Value = "" Then         lastrow = 1     Else         lastrow = wks.Range("A65536").End(xlUp).Row + 1     End If          c = Target.Row     Range(Cells(c, 3), Cells(c, 10)).Copy     wks.Activate     wks.Range("A" & lastrow).Select     ActiveSheet.Paste  End Sub

 

[Bassplayer]

I do something like this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)     Dim wks As Worksheet     Dim lastrow As Integer     Set wks = Worksheets("folha2")          If wks.Range("A1").Value = "" Then         lastrow = 1     Else         lastrow = wks.Range("A65536").End(xlUp).Row + 1     End If          c = Target.Row     Range(Cells(c, 3), Cells(c, 10)).Copy     wks.Activate     wks.Range("A" & lastrow).Select     ActiveSheet.Paste  End Sub

Thanks! There is only one thing missing. I just want to restrain the double click area from C3 to C10. If I double click, for example, in B2, it shouldn´t happen nothing.


Cheers,
Ricardo

 

[Momentman]

I have added a line of code to help with that

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim wks As Worksheet
    Dim lastrow As Integer
    Set wks = Worksheets("folha2")
    
    If wks.Range("A1").Value = "" Then
        lastrow = 1
    Else
        lastrow = wks.Range("A65536").End(xlUp).Row + 1
    End If
    
    'This next linedoes the trick
    If Not Intersect(Target, Range("c3:c10")) Is Nothing Then
        c = Target.Row
        Range(Cells(c, 3), Cells(c, 10)).Copy
        wks.Activate
        wks.Range("A" & lastrow).Select
        ActiveSheet.Paste
    End If
    
End Sub

 

[Bassplayer]

I have added a line of code to help with that

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim wks As Worksheet
    Dim lastrow As Integer
    Set wks = Worksheets("folha2")
    
    If wks.Range("A1").Value = "" Then
        lastrow = 1
    Else
        lastrow = wks.Range("A65536").End(xlUp).Row + 1
    End If
    
    'This next linedoes the trick
    If Not Intersect(Target, Range("c3:c10")) Is Nothing Then
        c = Target.Row
        Range(Cells(c, 3), Cells(c, 10)).Copy
        wks.Activate
        wks.Range("A" & lastrow).Select
        ActiveSheet.Paste
    End If
    
End Sub

Thanks Momentman! This code will help me a lot at work!


Cheers,
Ricardo

 

[Momentman]

YOu are welcome. Thanks for the feedback