Как копировать строки между листами на основе текстового значения

Question

Я пытаюсь скопировать всю строку с одного рабочего листа на другой рабочий лист, основываясь на вхождении определенного текстового значения («Да») в столбце H строки.

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

Не нужно проверять первые 1000 строк, если это нужно изменить, весь лист в порядке.

Спасибо.

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Jan 19")
    Set Target = ActiveWorkbook.Worksheets("Storage")

    J = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("H1:H1000")   ' Do 1000 rows
        If c = "yes" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

Answer 1

Я бы просто отфильтровал ваш диапазон, а затем скопировал отфильтрованные данные следующим образом:

Option Explicit
Sub CopyYes()

    Dim LastRow As Long, Col As Long, Lrow As Long
    Dim Source As Worksheet, Target As Worksheet
    Dim arrws
    Dim HandleIt As Variant

    ' Change worksheet designations as needed
    Set Target = ThisWorkbook.Worksheets("Storage")

    arrws = Array("Jan 19", "Feb 19") 'add all the worksheets you need to loop through

    For Each Source In ThisWorkbook.Worksheets

        HandleIt = Application.Match(Source.Name, arrws, 0)
        If Not IsError(HandleIt) Then
            With Source
                .UsedRange.AutoFilter Field:=8, Criteria1:="yes"
                LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
                Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
                Lrow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row + 1
                .Range("A2", .Cells(LastRow, Col)).SpecialCells(xlCellTypeVisible).Copy Target.Range("A" & Lrow)
            End With
        End If
    Next Source

End Sub

Вы получите тот же результат всего за один раз, избегая петли.