I need help Copying a row that is returned by a search to another sheet...

[Mr Clickalot]

Below is the current macro that I have, This searches the whole sheet for key words. It is ideal in the fact that it does not have to be exact. When it finds the entry it simply selects it but heres the problem;

Instead of just highlighting the cell I would like it to copy that row to the next sheet (in my case thats called "Bundle")...

Sub Find_Data()
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim currentSheet As Integer
On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = InputBox("Please enter the value to search for")
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.Count
For counter = 1 To sheetCount
Sheets(counter).Activate
If IsError(Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate) = False Then Exit For
Next counter
If ActiveCell.Value <> datatoFind Then
Sheets(currentSheet).Activate
End If
End Sub

Please give suggestions, If you have a better search macro for excel that searches key words and pastes I will be happy to give it a try!

 

[VoG]

Hello and welcome to MrExcel.

Try this with a copy of your workbook.

Sub Find_Data()
Dim datatoFind As Variant, Found As Range, ws As Worksheet, LR As Long
datatoFind = InputBox("Please enter the value to search for")
If datatoFind = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Bundle" Then
        Set Found = ws.UsedRange.Find(What:=datatoFind, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not Found Is Nothing Then Exit For
    End If
Next ws
If Found Is Nothing Then
    MsgBox "Not found", vbExclamation
    Exit Sub
Else
    With Sheets("Bundle")
        LR = Range("A" & Rows.Count).End(xlUp).Row
        Found.EntireRow.Copy Destination:=.Range("A" & LR + 1)
    End With
End If
Application.CutCopyMode = False
End Sub

 

[Mr Clickalot]

In the instance where I tried it it neither highlighted the correct entry nore did it paste anything onto sheet "bundle"

Slightly confused by this bit, is it referring to the sheet that its pasting to?

 If ws.Name <> "Bundle" Then

 

[VoG]

That in effect is saying don't search sheet Bundle for the value.

If you want the found value highlighted:

Sub Find_Data()
Dim datatoFind As Variant, Found As Range, ws As Worksheet, LR As Long
datatoFind = InputBox("Please enter the value to search for")
If datatoFind = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Bundle" Then
        Set Found = ws.UsedRange.Find(What:=datatoFind, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not Found Is Nothing Then Exit For
    End If
Next ws
If Found Is Nothing Then
    MsgBox "Not found", vbExclamation
    Exit Sub
Else
    Found.Interior.ColorIndex = 3
    With Sheets("Bundle")
        LR = Range("A" & Rows.Count).End(xlUp).Row
        Found.EntireRow.Copy Destination:=.Range("A" & LR + 1)
    End With
End If
Application.CutCopyMode = False
End Sub

Can you post a small sample of data from one sheet only using http://www.excel-jeanie-html.de/html/hlp_schnell_en.php and indicate an example of data that you want to find. Remove any sensitive information first!

 

[VoG]

****! I missed a dot

Sub Find_Data()
Dim datatoFind As Variant, Found As Range, ws As Worksheet, LR As Long
datatoFind = InputBox("Please enter the value to search for")
If datatoFind = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Bundle" Then
        Set Found = ws.UsedRange.Find(What:=datatoFind, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not Found Is Nothing Then Exit For
    End If
Next ws
If Found Is Nothing Then
    MsgBox "Not found", vbExclamation
    Exit Sub
Else
    Found.Interior.ColorIndex = 3
    With Sheets("Bundle")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Found.EntireRow.Copy Destination:=.Range("A" & LR + 1)
    End With
End If
Application.CutCopyMode = False
End Sub

 

[Mr Clickalot]

Sorry, I haven't used that website before or seen it, I am new to the forums and I am still getting use to things...

Basically when I search (example) for bob in a really long list I want it to find it and then paste that row in the the next emtpy row in the next sheet. I know how to do the search bit and the next row but I can't seem to get the copy and paste to work...

 

[Mr Clickalot]

Example:

There will be more columns but the idea is it pastes the name and all coloumns into another sheet.

 

[Mr Clickalot]

ok I have been messing around with this for ages now, the problem is getting it to copy and past... here is the current code atm but there is a problem, I just don't know what! This is just the last snippet:

Else
    Found.Interior.ColorIndex = 3
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).Row
        Found.EntireRow.Copy Destination:=.Range("A" & LR + 1).Select
        Sheets("Sheet2").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.Paste
    End With
End If
Application.CutCopyMode = False
End Sub

Sheet1 = This has the database on it
Sheet2 = This is where I want it to paste... The search button is also on this page

 

[VoG]

So you want to search Sheet1 for a value and paste the row to Sheet2?

Sub Find_Data()
Dim datatoFind As Variant, Found As Range, LR As Long
datatoFind = InputBox("Please enter the value to search for")
If datatoFind = "" Then Exit Sub
Set Found = Sheets("Sheet1").UsedRange.Find(What:=datatoFind, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Found Is Nothing Then
    MsgBox "Not found", vbExclamation
    Exit Sub
Else
    Found.Interior.ColorIndex = 3
    With Sheets("Sheet2")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Found.EntireRow.Copy Destination:=.Range("A" & LR + 1)
    End With
    Application.CutCopyMode = False
End If
End Sub

 

[Mr Clickalot]

Thanks a million... That really has helped... Now there is just a little bits which I have tried but I don't know how to change it...

Change 1: Instead of a input box;

datatoFind = InputBox("Please enter the value to search for")

Could I change it to; ex.

datatoFind = range("A1")