VBA для копирования ячеек, если они содержат строку

Question

Я пытаюсь написать макрос, который будет копировать все ячейки из листа, если они содержат строку.Например, если ячейки содержат www.ebay.com (который может быть частью более длинной строки, например https://www.ebay.com/itm/Portable-USB-Digital-MP3-Music-Player-LCD-Screen-Support-32GB-TF-Card-FM-Radio/121960292248) добавить в буфер обмена.

Answer 1

Вы можете изменить этот код и попробовать.

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