copying multiple listbox values to new sheet

[dan2010]

Hi,

i am currently having troubles writing code to copy multiple selected listbox values to a new sheet.what i am hoping to do is to let user select some items in listbox and show the selected name,risk value and cost on sheet 2.the risk value is calculated with a formula(age + length), cost (length+diameter). The code below is what i managed to find at the moment, however it will show all the values of name,risk value,cost,age,length,diameter. if i delete the values of age, length and diameter, the risk value and cost will turn to "0". So i am wondering if there is any code that can copy the info in listbox straight to sheet 2 instead of referring to sheet1.
any help will be greatly appreciated

Private Sub Commandbutton1_click()
dim a As Long
dim i As Long
a =1
For i = 0 To ListBox1.ListCount - 1
If Listbox1.selected(i) = True Then
worksheets("sheet1").Cells(i+1,1).EntireRow.Copy
Worksheets("sheet2").Cells(a,1).pastespecial
a = a+1
End If
Next i
End sub

sheet 1
name risk value cost age length diameter
a
b
c
d
e

listbox
name risk value cost
a
b
c
d
e

[Andy Pope]

Does it work if you provide a parameter to the PasteSpecial command

Worksheets("sheet2").Cells(a,1).pastespecial xlPasteValues

[dan2010]

it shows run-time error'1004'
pastespecial method of range class failed

i have attached an example to illustrate my point.

i am thinking whether is it possible to use the values from listbox to paste on sheet 2 if possible.

[Andy Pope]

This will copy the entire row from sheet1 to sheet2

Private Sub CommandButton1_Click()

Dim i As Long
Dim a As Long

a = 2
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then

    Sheet1.Range(ListBox1.RowSource).Cells(1, 1).Offset(i).EntireRow.Copy
    Sheet2.Cells(a, 1).PasteSpecial xlPasteValues
    a = a + 1
End If
Next i

End Sub

This will copy the first 3 columns only

Private Sub CommandButton1_Click()

Dim i As Long
Dim a As Long

a = 2
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then

    Sheet1.Range(ListBox1.RowSource).Cells(1, 1).Offset(i).Resize(1, 3).Copy
    Sheet2.Cells(a, 1).PasteSpecial xlPasteValues
    a = a + 1
End If
Next i

End Sub

If you want the records to append rather than start in row to then include

a = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
If a = 1 Then
    ' add header
    
    a = 2
Else
    a = a + 1
End If

[dan2010]

i am using excel 2007. i tried ur coding but error '1004' pop up. pastepspecial method of range class failed.i dont think "x1pastevalues" is available in my version :S

[Andy Pope]

I doubt anybody has x1PasteValues. That should be an L not a 1 (one)

xlPasteValues