isu01_MELB
02-21-2007, 10:28 PM
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:help I am new to VBA and having trouble wrapping my head around this one! Current code below;
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
Err_Execute:
MsgBox "An error has occurred", vbExclamation
End Sub
Thanks :banghead:
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
Err_Execute:
MsgBox "An error has occurred", vbExclamation
End Sub
Thanks :banghead: