I am trying to Search for a value in a column and copy row from Sheet1 and creating new sheet as MySheet and pasting that particular row .But I am getting run time error while pasting data in MySheet.Any suggestions please.
Data Input I am trying :
ID name price units desc
1 ikura 10 4 Mail Box
2 test 11 14 xxxx
3 test 11 14 yyyy
4 test 11 14 Mail Box
Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 4
LSearchRow = 4
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
Worksheets.Add (After:=Worksheets(Worksheets.Count)).Name = "MySheet"
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("MySheet").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Regards,
Raju
Try this simplified version:
Sub CopyData()
'// Turn off screen updating for cosmetics
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"
'// Change this to your sheet you are copying from
With Sheet1
'// Filter all rows with Mail Box
.Range("E:E").AutoFilter Field:=1, Criteria1:="Mail Box", Operator:=xlAnd
'// Copy all rows except header
.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets("MySheet").Cells(2, 1)
'// Remove the autofilter
If .AutoFilterMode Then .AutoFilterMode = False
End With
Application.ScreenUpdating = True
MsgBox "All matching data has been copied."
End Sub
First things first:
- Stop using .Select and .Activate when they're not needed, they're the
devil's methods. Deal with range/worksheet objects directly.
- Change your row counters from intergers to longs just in case.
- Explicitly declaring which worksheet you're working with can save yourself from odd bugs/errors. If you don't like the typing use a worksheet object.
- Your error handler should always output err.Number and
err.Description. If you'd done that from the beginning you
probably wouldn't have had to post this question.
- Range.Copy has a destination argument. Use it instead of Range.Paste
to save some potential headaches.
Here's some simplified code, see if it works:
Sub SearchForString()
Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim wksInput As Worksheet
Dim wksOutput As Worksheet
On Error GoTo Err_Execute
'Create a new sheet output to and store a reference to it
'in the wksOutput variable
Set wksOutput = Worksheets.Add(AFter:=Worksheets(Worksheets.Count))
wksOutput.Name = "MySheet"
'The wksInput variable will hold a reference to the worksheet
'that needs to be searched
Set wksInput = ThisWorkbook.Worksheets("Sheet2")
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
'Loop through all the rows that contain data in the worksheet
'Start search in row 4
For LSearchRow = 4 To wksInput.UsedRange.Rows.Count
'If value in column E = "Mail Box", copy entire row to wksOutput
If wksInput.Cells(LSearchRow, 5) = "Mail Box" Then
'One line copy/paste
wksInput.Rows(LSearchRow).Copy wksOutput.Cells(LCopyToRow, 1)
'Increment the output row
LCopyToRow = LCopyToRow + 1
End If
Next LSearchRow
With wksInput
.Activate
.Range("A3").Select
End With
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred. Number: " & Err.Number & " Description: " & Err.Description
End Sub
