Copy the column cells ("B:N") into the first empty row.

[harzer]

Hello everyone,
As I cannot resolve my problem, I am contacting you.
The purpose of my request is to copy the cells of the columns ("B:N") of the Active row to paste them in the first empty row.
Information: We do not take care of column "A" because we only work on columns ("B:N").

To better illustrate my request, we will take an example:
Suppose that I want to copy the cells of the columns ("B:N") of row No. 3, for this, I must select at least one cell in the range ("B3:N3"), so we know how to determine with ( ActiveCell) the line number.
When we know the line number, if we click on a button, we copy all the cells ("B3:N3") in the first empty line, in our case, the first line is line number 5 .

Here is the sheet before executing the code:

Code_Test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Jeune	Père	Mère	Eleveur	Âge	Volière	Cage	Né(e)	Tours	Couleur	Elevage	Consanguinité	ancêtre principale	Elevage
2	Ae27-001/2024 F	A1	B1	C1	D1	E1	F1	G1	H1	I1	J1	K1	L1	M1
3	Ae27-002/2024 M	A2	B2	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2
4	Ae27-003/2024 F	A3	B3	C3	D3	E3	F3	G3	H3	I3	J3	K3	L3	M3
5	Ae27-004/2024 F
6	Ae27-005/2024 M
7	Ae27-006/2024 M
8	Ae27-007/2024 M
9	Ae27-008/2024 M
10	Ae27-009/2024 M
11	Ae27-010/2024 M
12
13
14
15
Parents

Here is the sheet after running the code:

Code_Test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Jeune	Père	Mère	Eleveur	Âge	Volière	Cage	Né(e)	Tours	Couleur	Elevage	Consanguinité	ancêtre principale	Elevage
2	Ae27-001/2024 F	A1	B1	C1	D1	E1	F1	G1	H1	I1	J1	K1	L1	M1
3	Ae27-002/2024 M	A2	B2	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2
4	Ae27-003/2024 F	A3	B3	C3	D3	E3	F3	G3	H3	I3	J3	K3	L3	M3
5	Ae27-004/2024 F	A2	B2	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2
6	Ae27-005/2024 M
7	Ae27-006/2024 M
8	Ae27-007/2024 M
9	Ae27-008/2024 M
10	Ae27-009/2024 M
11	Ae27-010/2024 M
12
13
14
15
Parents

Thank you for your contributions.

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Parents" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Double click on any cell in the row that you want to copy.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    Dim lRow As Long
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target.Row > lRow Or Target.Row = 1 Then Exit Sub
    Application.ScreenUpdating = False
    Range("B" & Target.Row).Resize(, 13).Copy Cells(Rows.Count, "B").End(xlUp).Offset(1)
    Application.ScreenUpdating = True
End Sub

 

[harzer]

Hello mumps,
Thanks for your feedback.
I tested your code on a sheet that contains no other code except yours, the proposed solution works fine and gives me the correct result.
However, when I put your code in my project in Worksheet_BeforeDoubleClick, the program took a long time to run because in Worksheet_BeforeDoubleClick, I already had other codes running too, hence the slowness.
Could you (please) modify it, so as to link the code to a button so we don't touch the Worksheet_BeforeDoubleClick
Greetings.

 

[mumps]

Try:

Sub CopyRange()
    Range("B" & ActiveCell.Row).Resize(, 13).Copy Cells(Rows.Count, "B").End(xlUp).Offset(1)
End Sub

 

[harzer]

Hello mumps,
Thank you for your feedback and the proposed code.
The latter works very well.
Plus, a single line of code is magnificent.
Thank you again and we look forward to hearing from you on occasion.
Greetings.

 

[mumps]

You are very welcome.