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.