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