宏以累加其他电子表格中的所有行,并在其他工作表的一列中显示“是”

时间:2019-01-22 20:15:59

标签: excel vba

当前代码仅适用于电子表格中的一张纸和同一电子表格中的输出纸。宏总共需要读取七个源工作表,并将其粘贴到最后一个电子表格(最终供应商)中。

只需读取工作表1中的数据/行,将工作表1中第N列中带有“是”的完整行复制到最后工作表(最终供应商),然后读取下一个工作表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

1 个答案:

答案 0 :(得分: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