wb = Dir(Folder & Application.PathSeparator & "*.xlsx")

lr = shSrc.Cells(shSrc.Rows.Count, 2).End(xlUp).Row

If shSrc.Cells(i, "B") Like "Описание" Then

Sub пакетное_копирование_строки_по_условию()
    Dim Folder As String
    Dim wb As String
    Dim objWb As Workbook
    Dim workWb As Workbook
    Dim i As Integer
    Set workWb = ActiveWorkbook  'Запоминаем активную книгу

    'Показываем диалог выбора папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку, файлы в которой нужно обработать"
        .ButtonName = "Выбрать"
        .AllowMultiSelect = False
        If .Show Then Folder = .SelectedItems(1) Else Exit Sub
    End With
    'Начинаем читать файлы из папки
    wb = Dir(Folder & Application.PathSeparator & "*.xlsx")
    While Len(wb) > 0
        i = i + 1
        wb = Folder & Application.PathSeparator & wb
        Set objWb = Workbooks.Open(wb)

    Application.ScreenUpdating = False
    
    'Начинаем копировать строки, удовлетваряющие условию в активную книгу
    With objWb.Sheets(1)
            lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            For j = 2 To lastRow
                If .Cells(j, "B") Like "Описание" Then Sheets(1).Row.Copy ................................... 'тут я не могу сообразить
                End If
            Next
        End With
    With Application
        .ScreenUpdating = False: .CutCopyMode = False
    End With
    
    'Отключаем проверку совместимости при закрытии и сохранении файлов
    ActiveWorkbook.CheckCompatibility = False
    objWb.Close True
    wb = Dir    'читаем следующий файл
    Wend
End Sub

Sub УдалениеСтрокПоУсловию()
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ТекстДляПоиска = "Наименование ценности"    ' удаляем строки с таким текстом

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
End Sub

Sub tt()
    Dim sh As Object
    With CreateObject("Scripting.Dictionary"): .comparemode = 1
        For Each sh In Worksheets
            If sh.Range("C1") = "ДКС" Then .Item(sh.Name) = 0&
        Next
        If .Count <> 0 Then Sheets(.keys).Copy Else MsgBox "Листов для копирования нет"
    End With
End Sub
 

Sub test()
    Dim Folder As String
    Dim wb As String
    Dim objWb As Workbook
    Dim workWb As Workbook
    Dim i As Integer
    Set workWb = ActiveWorkbook  'Запоминаем активную книгу

    'Показываем диалог выбора папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку, файлы в которой нужно обработать"
        .ButtonName = "Выбрать"
        .AllowMultiSelect = False
        If .Show Then Folder = .SelectedItems(1) Else Exit Sub
    End With
    'Начинаем читать файлы из папки
    wb = Dir(Folder & Application.PathSeparator & "*.xls")
    While Len(wb) > 0
        i = i + 1
        wb = Folder & Application.PathSeparator & wb
        Set objWb = Workbooks.Open(wb)

        With objWb.Sheets(1)
            lastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
            For j = 2 To lastRow
                If .Cells(j, "F") Like "шт" Then
                   .Cells(j, "F") = "ед"
                ElseIf .Cells(j, "E") Like "шт" Then
                       .Cells(j, "G") = "шт"
                ElseIf .Cells(j, "E") Like "шт" Then
                       .Cells(j, "E") = ""
                End If
            Next
        End With

        ActiveWorkbook.CheckCompatibility = False
        objWb.Close True
        wb = Dir    'читаем следующий файл
    Wend
End Sub
 

        Sheets(.keys).Copy