Макрос для накопления всех строк в других таблицах с «Да» в одном столбце других листов

Question

Текущий код предназначен только для одного листа в электронной таблице и выходного листа в той же электронной таблице. Существует всего семь исходных листов, из которых макрос должен считывать / получать данные и вставлять строки в последнюю электронную таблицу (конечные поставщики).

Просто нужно прочитать данные / строки на листе 1, скопировать полные строки с «Да» в столбце N на листе 1 на последний лист (конечные поставщики), затем прочитать следующий лист 2, затем лист 3 ... копировать все строки от каждого листа до окончательного листа, чтобы указать, какие поставщики больше не по контракту. Прокомментированный код - это кое-что, что мне не повезло.

Sub VendorStop()

Dim Inrow As Integer       '** Record counter for rows read
Dim LastInRow As Integer   '** InRow is the current row in the Input WS
Dim LastOutRow As Integer  '** OutRow is the current row in Ending Vendors
Dim WSIn As Worksheet      '** Input Worksheet
Dim WSOut As Worksheet     '** Output WorkSheet – always Ending Vendors
Dim TempCell As String     '** Temp Var

Set WSIn = Sheets("Vendor Spend")      '** Set Input Worksheet
Set WSOut = Sheets("Ending Vendors")   '** Set Output Worksheet

Inrow = 2                 '** initialize row counter

LastInRow = WSIn.Cells(WSIn.Rows.Count, "A").End(xlUp).Row      '** identify last row in Input sheet
LastOutRow = WSOut.Cells(WSOut.Rows.Count, "A").End(xlUp).Row   '** identify last row in Output sheet

'** Process each row in Input worksheet

    Do Until Inrow = LastInRow

'        Rows(InRow).Select
        TempCell = WSIn.Cells(Inrow, 14)

        If Trim(WSIn.Cells(Inrow, 14)) = "Yes" Then

            '** Sheets("Ending Vendors").Select
            WSIn.Range("a1:u1").Copy

            '** ActiveSheet.Paste
            WSOut.Cells(LastOutRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        '** Application.CutCopyMode = False
        End If
'**  Increase Row count for input Spreadsheet
        Inrow = Inrow + 1
    Loop

Application.CutCopyMode = False

End Sub

Answer 1

Вы можете немного сократить свой код, используя цикл For-Next вместо Do-Until и заменяя операции Copy-Paste установкой значения Range напрямую.Кроме того, если вы не используете TempCell, вы можете просто удалить его.

Sub VendorStop()

Dim Inrow As Integer       '** Record counter for rows read
Dim LastInRow As Integer   '** InRow is the current row in the Input WS
Dim LastOutRow As Integer  '** OutRow is the current row in Ending Vendors
Dim WSIn As Worksheet      '** Input Worksheet
Dim WSOut As Worksheet     '** Output WorkSheet – always Ending Vendors
Dim TempCell As String     '** Temp Var

Set WSIn = Sheets("Vendor Spend")      '** Set Input Worksheet
Set WSOut = Sheets("Ending Vendors")   '** Set Output Worksheet

LastInRow = WSIn.Cells(WSIn.Rows.Count, "A").End(xlUp).Row      '** identify last row in Input sheet
LastOutRow = WSOut.Cells(WSOut.Rows.Count, "A").End(xlUp).Row   '** identify last row in Output sheet

'** Process each row in Input worksheet

    For Inrow = 2 To LastInRow
        TempCell = WSIn.Cells(Inrow, 14)
        If Trim(WSIn.Cells(Inrow, 14)) = "Yes" Then
            WSOut.Range("A" & LastOutRow + 1 & ":U" & LastOutRow + 1) = WSIn.Range("A" & InRow & ":U" & InRow)
            LastOutRow = LastOutRow + 1
        End If
    Next

End Sub