User Form to Copy Rows

[pwill]

Hi can anyone help with vba code for a UserForm?

I have a UserForm with Textbox1 under a Label(Start) and Textbox2 under a Label(How Many)
And a CommandButton

On Sheet1 -

Column A with Dates ("A2:A)

Column D with a Count From 1 to 12000 ("D2:D)

Columns E2:K with Row Data for each Date and Count

I want to enter a Count value from ColumnD into Textbox1 - ie - 100

Then in Textbox2 enter how many - ie - 20

Then Click the CommandButton and Copy the 20 Rows of Data From Columns ("A101:A120" & ", D101:K120") To Columns ("AI2:AQ")

eg

	A	B	C	D	E	F	G	H	I	J	K	L	M					AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ
1	Date/Year			Cnt			Results													Date/Year	Cnt			Results
2	07/04/18			1	0	0	0	0	0	0	0									26/05/18	100	0	0	0	0	0	0	0
3	07/04/18			2	0	0	0	0	0	0	0									27/05/18	101	0	0	0	0	0	0	0
4	08/04/18			3	0	0	0	0	0	0	0									27/05/18	102	0	0	0	0	0	0	0
5	08/04/18			4	0	0	0	0	0	0	0									28/05/18	103	0	0	0	0	0	0	0
6	09/04/18			5	0	0	0	0	0	0	0									28/05/18	104	0	0	0	0	0	0	0
7	09/04/18			6	0	0	0	0	0	0	0									29/05/18	105	0	0	0	0	0	0	0
8	10/04/18			7	0	0	0	0	0	0	0									29/05/18	106	0	0	0	0	0	0	0
9	10/04/18			8	0	0	0	0	0	0	0									30/05/18	107	0	0	0	0	0	0	0
10	11/04/18			9	0	0	0	0	0	0	0									30/05/18	108	0	0	0	0	0	0	0
11	11/04/18			10	0	0	0	0	0	0	0									31/05/18	109	0	0	0	0	0	0	0
12	12/04/18			11	0	0	0	0	0	0	0									31/05/18	110	0	0	0	0	0	0	0
13	12/04/18			12	0	0	0	0	0	0	0									01/06/18	111	0	0	0	0	0	0	0
14	13/04/18			13	0	0	0	0	0	0	0									01/06/18	112	0	0	0	0	0	0	0
15	13/04/18			14	0	0	0	0	0	0	0									02/06/18	113	0	0	0	0	0	0	0
16	14/04/18			15	0	0	0	0	0	0	0									02/06/18	114	0	0	0	0	0	0	0
17	14/04/18			16	0	0	0	0	0	0	0									03/06/18	115	0	0	0	0	0	0	0
18	15/04/18			17	0	0	0	0	0	0	0									03/06/18	116	0	0	0	0	0	0	0
19	15/04/18			18	0	0	0	0	0	0	0									04/06/18	117	0	0	0	0	0	0	0
20	16/04/18			19	0	0	0	0	0	0	0									04/06/18	118	0	0	0	0	0	0	0
21	16/04/18			20	0	0	0	0	0	0	0									05/06/18	119	0	0	0	0	0	0	0
22	17/04/18			21	0	0	0	0	0	0	0
23	17/04/18			22	0	0	0	0	0	0	0
24	18/04/18			23	0	0	0	0	0	0	0
25	18/04/18			24	0	0	0	0	0	0	0
26	19/04/18			25	0	0	0	0	0	0	0

<tbody>
</tbody>

Any help would be appreciated

Regards

pwill

 

[Roderick_E]

This would start in the exact row selected, 100 not 101 and would end at 120. Also as is, it copies over anything in the destination columns
From your command button, call copyrows

sub copyrows
dim startrow as long
dim endrow as long
dim x as long
dim cnt as long
startrow = int(userform1.textbox1.value)
endrow = int(userform1.textbox2.value)
if  startrow<1 or endrow<1 or endrow>startrow then
msgbox "Invalid start or end rows",vbcritical,"ALERT"
exit sub
endif
cnt = 2 'indicate first row where data should copy (could use lastrow+1 of destination column if you want to keep appending)
endrow = startrow+endrow
for x = startrow to endrow
cells(cnt,"AI") = cells(x,"a")
cells(cnt,"AJ") = cells(x,"b")
cells(cnt,"AK") = cells(x,"c")
cells(cnt,"AL") = cells(x,"d")
cells(cnt,"AM") = cells(x,"e")
cells(cnt,"AN") = cells(x,"f")
cells(cnt,"AO") = cells(x,"g")
cells(cnt,"AP") = cells(x,"h")
cells(cnt,"AQ") = cells(x,"i")
cnt = cnt + 1
next x
end sub

 

[pwill]

Thank you Roderick_E, I will give it a try out now and let you know how I get on.

much appreciated

pwill

 

[pwill]

Hi Roderick_E, Thank you that's exactly what I need and I can adjust to my needs with the rows but when I try to enter below 10 as a start value in textbox1 it gives the message box error?

is it possible adjust the code to include values starting from below 10?

pwill

 

[Roderick_E]

Hi Roderick_E, Thank you that's exactly what I need and I can adjust to my needs with the rows but when I try to enter below 10 as a start value in textbox1 it gives the message box error?

is it possible adjust the code to include values starting from below 10?

pwill

Glad it worked. I fixed that issue in this version:

sub copyrows
dim startrow as long
dim endrow as long
dim x as long
dim cnt as long
startrow = int(userform1.textbox1.value)
endrow = int(userform1.textbox2.value)
if  startrow<1 or endrow<1 then
msgbox "Invalid start or end rows",vbcritical,"ALERT"
exit sub
endif
cnt = 2 'indicate first row where data should copy (could use lastrow+1 of destination column if you want to keep appending)
endrow = startrow+endrow
for x = startrow to endrow
cells(cnt,"AI") = cells(x,"a")
cells(cnt,"AJ") = cells(x,"b")
cells(cnt,"AK") = cells(x,"c")
cells(cnt,"AL") = cells(x,"d")
cells(cnt,"AM") = cells(x,"e")
cells(cnt,"AN") = cells(x,"f")
cells(cnt,"AO") = cells(x,"g")
cells(cnt,"AP") = cells(x,"h")
cells(cnt,"AQ") = cells(x,"i")
cnt = cnt + 1
next x
end sub

 

[pwill]

Thank you Roderick_E, works like a charm now very nice...

much appreciated

regards

pwill


​