VB Help with code to copy selected rows to specified cells in another sheet.

[Excel_Assis]

Hi
Could I please ask help from someone with VB code.
The VB below should by clicking in the cell column H next to the row of data needed then copy the data to a another sheet at this point it is sheet6 at a specified start cell. There are several source sheets and the selected data from these sheets needs to be copied to sheet6 at a specified starting cell.

At present when the cell is clicked the tick font is made visible meaning the row selected and then viewing the destination sheet. only the first cell of data from source sheet is shown and if two rows are selected from source sheet only the last selected row first cell is shown. Meaning the copy overwrites the previous and does not increment by one row.





Source Sheet = Cost1

B C D E F G H

Cost1						Select Required
Description	Type	Min # of Units		Cost/Unit	Total
unit 1	Unit 1 type	2		$ 30.00	$ 60.00	a
unit 2	Unit 2 type	0		$ 5.00	$ -
unit 3	Unit 3 type	3		$ 20.00	$ 60.00	a
unit 4	Unit 4 type	0		$ 5.00	$ -
unit 5	Unit 5 type	0		$ 10.00	$ -
				Total	$ 120.00

Select and Copy Code


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H8:H12")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If


'/// Below code will copy Selected items to sheet6

'Copy Items to sheet6 and start at selected cell and incrament by 1 row.
If Not Intersect(Target, Range("H8:H12")) Is Nothing Then
Select Case Target.Value
Case "a"
Cells(Target.Row, 1).Copy Destination:=Sheet6.Range("D10").End(xlUp).Offset(1, 0)
End Select
End If

End Sub

[/CODE]

 

[kvsrinivasamurthy]

Sorry. Try this code

selection.resize(,4).Copy Destination:=Sheet6.Range("D"  & rows.count).End(xlUp).Offset(1, 0)

 

[Excel_Assis]

I don't understand what you want.
Try.

selection.resize(1,4).Copy Destination:=Sheet6.Range("D"  & rows.count).End(xlUp).Offset(1, 0)

Hi thank you for your reply after making your suggested changes only the two ticks are copied to sheet2 D2:D3. Images attached.

Source Sheet1

Sheet1 data copy sheet2 sample.xlsm
	A	B	C	D	E	F	G	H	I
3
4
5	Cost1							Select Required
6
7	Description	Type	Min # of Units		Cost/Unit	Total		Select Required
8
9	unit 1	Unit 1 type	2		$ 30.00	$ 60.00		a
10	unit 2	Unit 2 type	0		$ 5.00	$ -
11	unit 3	Unit 3 type	3		$ 20.00	$ 60.00		a
12	unit 4	Unit 4 type	0		$ 5.00	$ -
13	unit 5	Unit 5 type	0		$ 10.00	$ -
14					Total	$ 120.00
15
16
17
18
Sheet1

Cell Formulas
Range	Formula
F9:F13	F9	=SUM(C9*E9)
F14	F14	=SUM(F9:F13)

Destination Sheet2

Sheet1 data copy sheet2 sample.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2				a
3				a
4
5
6
7
8
9
10								60.00
11								60.00
12								0.00
13								0.00
14								0.00
15								0.00
16								0.00
17								0.00
18								0.00
19								0.00
20							TOTAL	$120.00
21
22
Sheet2

Cell Formulas
Range	Formula
H12:H19	H12	=F12*G12
H20	H20	=SUM(H10:H19)

Destination sheet2 should look like the following I manually edited it to show what the result should look like.

Sheet1 data copy sheet2 sample.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2
3
4
5
6
7
8
9
10				unit1	unit 1 type	2	$30.00	60.00
11				unit3	unit 3 type	3	$20.00	60.00
12								0.00
13								0.00
14								0.00
15								0.00
16								0.00
17								0.00
18								0.00
19								0.00
20							TOTAL	$120.00
21
22
Sheet2

Cell Formulas
Range	Formula
H12:H19	H12	=F12*G12
H20	H20	=SUM(H10:H19)

 

[Excel_Assis]

Sorry. Try this code

selection.resize(,4).Copy Destination:=Sheet6.Range("D"  & rows.count).End(xlUp).Offset(1, 0)

Sorry I tried this and it did the same thing copying the ticks to sheet2 D2 and D3.