Копирование и вставка строк с определенным текстом из выбранной книги

Question

Я совершенно новичок в VBA, поэтому не умею много писать. Я хочу иметь возможность выбирать, какой файл копировать и вставлять в мою книгу. Я написал первую часть своего кода:

Sub BCR_2019()
Dim FileToOpen As Variant
Dim Openbook As Workbook
Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Select one file", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
    Set Openbook = Application.Workbooks.Open(FileToOpen)
    Openbook.Sheets(1).Range("A1:E20").Copy
    ThisWorkbook.Worksheets("Sheet1").Range("C2").Paste
    Openbook.Close False
    
End If

Application.ScreenUpdating = True

End Sub

Сейчас он просто копирует и вставляет A1: E20. Но я хочу, чтобы макрос копировал и вставлял только те строки, где SOW включает «tq», данные выглядят так:

введите описание изображения здесь

Я просто не знаю, куда поместить остальную часть кода или как закодировать эту часть.

Любая помощь будет принята с благодарностью.

Answer 1

Комбинируя код из вашего вопроса и ваших комментариев, вы можете сделать что-то вроде этого (не тестировалось, но если есть какие-то проблемы, прокомментируйте ниже)

Sub BCR_2019()
    Dim FileToOpen As Variant
    Dim Openbook As Workbook
    Application.ScreenUpdating = False
    
    FileToOpen = Application.GetOpenFilename(Title:="Select one file", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set Openbook = Application.Workbooks.Open(FileToOpen)
        With Openbook.Sheets(1).Range("A1:E20")
            .AutoFilter Field:=2, Criteria1:="*tq*" ' or if always ends with tq then use "*tq"
            .Copy Destination:=ThisWorkbook.Worksheets("Sheet1").Range("C2")
            Openbook.Close False
            
            ' Now you can do some cleaning
            ' Remove the added autofilter
            .AutoFilter
            ' Stop the "copy" flickering border
            Application.CutCopyMode = False
        End With
    End If
    
    Application.ScreenUpdating = True
End Sub

Надеюсь, это поможет