VBA to copy cells if they contain a string

Question

I am trying to write a macro that will copy all cells from a sheet if they contain a string. For example, if cells contain www.ebay.com (which can be part of a longer string, like https://www.ebay.com/itm/Portable-USB-Digital-MP3-Music-Player-LCD-Screen-Support-32GB-TF-Card-FM-Radio/121960292248 ) add to clipboard.

Answer 1

You can modify this code and try.

Option Explicit

Sub test()

    Dim Lastrow As Long, i As Long
    Dim strToSearch As String
    Dim obj As Object

    Set obj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With ThisWorkbook.Worksheets("Sheet1")

        strToSearch = "Ebay"

        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To Lastrow
            'Have in mind that InStr is case sensitive.
            If InStr(1, .Range("A" & i).Value, strToSearch) > 0 Then
                'Just Copy
                .Range("A" & i).Copy
                'Put in clipboard
                obj.SetText .Range("A" & i).Value
                obj.PutInClipboard
                Set obj = Nothing
            End If
        Next i

    End With

End Sub