Найти строку в другой Spreedsheet от пользователя и скопировать строку

Question

Код находит строку на основе ввода, но не копирует ее обратно в мою рабочую книгу.

Код запрашивает у пользователя имя рабочей книги, чтобы проверить соответствие строки импорту пользователя. Мне нужно найти строку и на основе полка А и скопировать строку в мою рабочую книгу. Я не получаю сообщение об ошибке, но строка не копируется обратно

Sub Macro1()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim myValue As Variant

    With Application.FileDialog(msoFileDialogFilePicker)  
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1     
        .Show                
        fullpath = .SelectedItems.Item(1)
    End With

    If InStr(fullpath, ".xls") = 0 Then
        Exit Sub
    End If

    Workbooks.Open fullpath

    Set wb = ActiveWorkbook
    wb.Activate

    myValue = InputBox("Enter Value to lookup")

    wb.Activate    

    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row

    For i = 1 To RowCount
        Range("a" & i).Select
        check_value = ActiveCell
        If check_value = myValue Then        
            ActiveCell.EntireRow.Copy
            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
            Range("a" & RowCount + 1).Select
            Sheets("Sheet2").Paste
            Workbooks("wip - copy.xlsm").Activate
            Sheets("Sheet2").Paste
        End If
    Next

    Workbooks("wip - copy.xlsm").Activate
    Sheets("Sheet2").Select       
End Sub

Answer 1

Вы можете сделать что-то вроде этого (используя Match, чтобы найти интересующие строки):

Sub Macro1()

    Dim wb As Workbook, fullPath
    Dim ws As Worksheet, wsDest As Worksheet
    Dim m As Variant, myValue As Variant

    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        .Show
        fullPath = .SelectedItems.Item(1)
    End With

    If InStr(fullPath, ".xls") = 0 Then Exit Sub

    Set wb = Workbooks.Open(fullPath) '<< get a direct reference
    Set ws = wb.Sheets(1)

    Set wsDest = ThisWorkbook.Sheets("Sheet2")

    myValue = InputBox("Enter Value to lookup")

    m = Application.Match(myValue, ws.Columns("A"), 0)
    Do While Not IsError(m)
        'got a match - copy row
        ws.Rows(m).Copy _
            wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Offset(1, 0)

        m = Application.Match(myValue, _
               ws.Range(ws.Cells(m + 1, 1), ws.Cells(ws.Rows.Count, 1)), 0)
    Loop

End Sub