Copy data from merged cells on clicking

Question

The below code copies cell data (range F1:H19), on clicking, and pastes them to the last row of a different worksheet of the same workbook.

When I click on merged cells nothing happens. Like when cells are empty.

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

If Not Intersect(Target, Range("f1:h19")) Is Nothing Then
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("sheet1").Cells(Rows.Count, "C").End(xlUp).Row + 1
    Target.Copy Sheets("sheet1").Cells(Lastrow, 3)
End If

End Sub

When you double click a merged cell, Target.Cells.Count is greater than 1. I would check Range.MergeCells and if true proceed. — BigBen
If you're copying merged cells, you might want Target.Cells(1,1).Copy instead of Target.Copy. — BigBen
@BigBen could you please apply it in the code. I am beginner ;) — AM-NL

BigBen BigBen · Accepted Answer · 2020-04-06T15:04:10

Nothing is happening, because if Target is a merged cell, then Target.Cells.Count is greater than 1.

I would change your logic using Range.MergeCells to determine if a merged cell was clicked:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Me.Range("f1:h19")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If

    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("sheet1").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("sheet1").Cells(Lastrow, 3)
End Sub

Copy data from merged cells on clicking

1 Answers