简体   繁体   中英

Need Macro to find a cell value and then copy the entire line to a new sheet

Trying to create a macro that will do a search for a cell value, then when found cut the entire row and past it to another sheet!

Help is appreciated, I've never programmed before in excel....

Sub test2()
Dim cel As Range, lRow As Long

findWhat = InputBox("Enter what you want to find?", "Find what...")

For Each cel In ThisWorkbook.Sheets("Sheet1").Range("W2:W250000" &Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
    
    If cel.Value = findWhat Then
        lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        ThisWorkbook.Sheets("Sheet2").Cells(lRow + 1, 1).Value = ThisWorkbook.Sheets("Sheet2").Cells(cel.Row, 1).Resize(, 48)
    End If
  Next
End Sub

I am just modifying some of your existing code to do what is required, assuming that you want to search only in column W and then copy the entire row if a match is found.

Sub test2()
Dim cel As Range, lRow As Long

findWhat = InputBox("Enter what you want to find?", "Find what...")

'Following loop will only search for the values in column W and between rows 2 to 250000, change the values as required.
For Each cel In ThisWorkbook.Sheets("Sheet1").Range("W2:W250000")
    
    If cel.Value = findWhat Then
        currentRow = cel.Row
        lRow = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Thisworkbook.Sheets("Sheet1").Rows(currentRow).EntireRow.copy
        ThisWorkbook.Sheets("Sheet2").Range("A" & lRow + 1 ).Select
        ThisWorkbook.Sheets("Sheet2").Paste 
        Thisworkbook.Sheets("Sheet1").Rows(currentRow).EntireRow.Delete 
    End If
  Next
End Sub

UPDATE : This code will copy all the rows that matches the given value.

If you're just needing to find the input value once within the range you could use this to copy. If you're wanting to cut the line that you copy from as well then take away the ' from the delete line in the code.

This is for if you just want the first found cell:

Sub test2()

Dim lRow1 As Long, lRow2 As Long, found As Range, findwhat As String

findwhat = InputBox("Enter what you want to find?", "Find what...")
lRow1 = ThisWorkbook.Sheets("Sheet1").Range("W" & Rows.Count).End(xlUp).Row
lRow2 = ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

Set found = Sheets("Sheet1").Range("W2:W" & lRow1).Find(What:=findwhat, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)

If Not found Is Nothing Then
    Sheets("Sheet1").Range("W" & found.Row).EntireRow.Copy
    Sheets("Sheet2").Range("A" & lRow2 + 1).PasteSpecial
    'Sheets("Sheet1").Range("W" & found.Row).EntireRow.Delete
End If

Application.CutCopyMode = False

End Sub 

EDIT: If you're needing every row that is found with that value then use this one. It's just modified from yours which is pretty much the easiest way to do it: EDIT2: Changed it so now it loops from the bottom up which resolves the issue of skipping some of them after deleting the row.

Sub test2()

Dim lRow1 As Long, lRow2 As Long, findwhat As String, cel As Range, Sh1 As Worksheet, Sh2 As Worksheet, i As Long

findwhat = InputBox("Enter what you want to find?", "Find what...")
lRow1 = ThisWorkbook.Sheets("Sheet1").Range("W" & Rows.Count).End(xlUp).Row
Set Sh1 = ThisWorkbook.Sheets("Sheet1")
Set Sh2 = ThisWorkbook.Sheets("Sheet2")

For i = lRow1 To 2 Step -1
    If Sh1.Range("W" & i).Value = findwhat Then
        
        lRow2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row
        Sh1.Range("W" & i).EntireRow.Copy
        Sh2.Range("A" & lRow2 + 1).PasteSpecial
        Sh1.Range("W" & i).EntireRow.Delete
    End If
Next i

Application.CutCopyMode = False

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM