Transfer specific rows that contain data

[Gemsie]

I have a file that is set up as a pricing list. Column 10 is the one where quantities are written own and it automatically calculates the price.

However, is there a way of only transferring those rows which have had products selected onto a second worksheet, in order to make a "summary invoice"?

I'll be honest, I'm a complete amateur at VBA so tried the following after attempting to edit someone else's code, but it's not working.

Sub RemoveErrors()

Application.ScreenUpdating = False

Dim LastRow As Long
Dim BadRow As Range

LastRow = Cells(Rows.Count, "G").End(xlUp).Row

Sheets("Sheet1").Select
Range("G3" & LastRow).Select
For Each BadRow In Range("G3" & LastRow)

Select Case BadRow.Value

Case "1"
BadRow.EntireRow.Select
Selection.Cut
Sheets("Sheet2").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste

Case "2"
BadRow.EntireRow.Select
Selection.Cut
Sheets("Sheet2").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste

End Select

Next BadRow

End Sub

 

[Gemsie]

Okay, I've tried again and I think it works?!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, LastRow

LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A2:I500").ClearContents
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "G").Value = "1" Then
Sheets("Sheet1").Cells(i, "G").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i


End Sub

Not entirely sure if I can change it to reflect people buying multiples of things though...


EDIT: Yep, have no idea how to add multiples!

 

[Gemsie]

All sorted with multiples now (=>1). Thread can be closed.