Copy rows from multiple worksheets

[isu01_MELB]

Hi All, can anybody help with code for copying rows from multiple worksheets onto one mastersheet? The rows to be copied are selected by the user which returns a value in column A of "1". The code I have should then pick up the row selected and copy it to a mastersheets but isnt working I am new to VBA and having trouble wrapping my head around this one! Current code below;

[VBA]
Sub SearchForString()
Application.ScreenUpdating = False
Sheets("Interior").Visible = True
Sheets("Exterior").Visible = True
Sheets("Driver Assist").Visible = True
Sheets("Quote").Visible = True
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 9 in Sheet8("Quote") (row counter variable)
LCopyToRow = 9

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column A = 1, copy entire row to Sheet8("Quote")
If Range("A" & CStr(LSearchRow)).Value = 1 Then

'Select row in Worksheets to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet8("Quote") in next row
Sheets("Quote").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1("Interior") to continue searching
Sheets("Interior").Select

End If

LSearchRow = LSearchRow + 1
Wend
'Position on cell I6
Application.CutCopyMode = False
Range("I6").Select

MsgBox "Quote Produced.", vbInformation

Sheets("Interior").Visible = False
Sheets("Exterior").Visible = False
Sheets("Driver Assist").Visible = False
Sheets("Protection Packs").Visible = False

Exit Sub
[/VBA]

Err_Execute:
MsgBox "An error has occurred", vbExclamation
End Sub

Thanks

[JimmyTheHand]

Hi

Welcome to VBAX!

You don't have to select a range to copy it. Simply:
[vba]Range1.Copy Destination:=Range2[/vba] I suppose you make sheets visible because it is needed for Select. As you don't need Seelct, you don't need to unhide sheets either. The latter, in turn, makes Application.ScreenUpdating = False unnecessary. Also, I don't see the significance of positioning on cell "I6", because that sheet ("Interior") will be hidden anyway. When removing all the unnecessary lines and updating where needed, I got the following:

[vba] Sub SearchForString()
Dim Src as Worksheet, Tgt as Worksheet
Dim LSearchRow As Long, LCopyToRow As Long

Set Src = Sheets("Interior")
Set Tgt = Sheets("Quote")

Tgt.Visible = True

On Error GoTo Err_Execute

Tgt.Activate

'Start search in row 5
LSearchRow = 5

'Start copying data to row 9 in Sheet8("Quote") (row counter variable)
LCopyToRow = 9

While Len(Src.Range("A" & LSearchRow).Value) > 0

'If value in column A = 1, copy entire row to Sheet8("Quote")
If Src.Range("A" & LSearchRow).Value = 1 Then

'copy row
Src.Rows(LSearchRow).Copy Destination:=Tgt.Rows(LCopyToRow)

'Move counter to next row
LCopyToRow = LCopyToRow + 1

End If

LSearchRow = LSearchRow + 1
Wend

MsgBox "Quote Produced.", vbInformation

Sheets("Protection Packs").Visible = False

Exit Sub

Err_Execute:
MsgBox "An error has occurred", vbExclamation
End Sub[/vba]
I didn't test the code because I was too lazy to set up a workbook with such sheets. But I'm pretty sure it works. I also think it could be improved further, but more info is needed for that.

Two pieces of advice:
1) Generally, it is advantageous to upload your workbook, or a sample file, so that others can see and understand more easily what you want to accomplish.
2) Use VBA tags when posting code. It makes the code more readable. And it looks better, anyway.

HTH

Jimmy

[isu01_MELB]

Thanks Jimmy - this has put me on the right track although still have some problems.

I have attached a test sample of what Im working on which should give a clearer picture of what Im trying to do.

I think I am going wrong with having blank rows in my worksheets? Also, need the macro to run through all the worksheets - the attached should make it clearer.

Thanks heaps

[JimmyTheHand]

Thanks Jimmy

Welcome

I think I am going wrong with having blank rows in my worksheets?

Well, I think they're not a problem to give up on, but they surely seem to be an unnecessary obstacle. The whole thing depends on what their purpose is. If they exist only to separate stock items, that could be done by setting rowheight, too...

Anyway, I modified your test workbook, see the attachment. There's a new sub called CreateQuote. Might not be the one you need, but will show the logic I would use.

BTW, you should make the Stock sheets look more consistent. The rows with white background are of different length, and so the quote looks rather silly...