I am trying to find a script that finds certain values in sheet1 and paste those values in sheet2 A1.
- the range is whole sheet1
- needs to search all cells for anything that starts with "1Z" and "W"
- paste each cell data that starts with "1Z" and "W" in sheet2 under row A.
Currently have this script:
Sub delete_oldads()
Dim cel As Range, cfind As Range
ActiveSheet.UsedRange.Select
For Each cel In Selection
If cel = "" Then GoTo nextcel
Set cfind = cel.Find(what:="1Z", lookat:=xlPart)
If Not cfind Is Nothing Then
cfind.Copy Cells(cfind.Row, "A")
cfind.Clear
End If
nextcel:
Next cel
End Sub
But this one copy/paste all the matching cells in the same sheet and also if a match is found in the same row, it will copy the last one only.
Answer
This does not use FIND() and may be a little slow:
Sub poiuyt()
Dim K As Long, r As Range
Dim sh2 As Worksheet
Set sh2 = Sheets("Sheet2")
K = 1
With Sheets("Sheet1")
For Each r In .UsedRange
v = r.Value
If v <> "" Then
If Left(v, 1) = "W" Or Left(v, 2) = "IZ" Then
r.Copy sh2.Cells(K, 1)
K = K + 1
End If
End If
Next r
End With
End Sub
No comments:
Post a Comment