0
votes

I am trying to find a script that finds certain values in sheet1 and paste those values in sheet2 A1.

  1. the range is whole sheet1
  2. needs to search all cells for anything that starts with "1Z" and "W"
  3. 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.

1
Um... good luck? Is there a question behind your statement?Dirk Reichel

1 Answers

0
votes

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