[英]Script to move cell values according to bg colour
下面的代码是我到目前为止所拥有的。 但是由于某种原因,它说我有一个不带for的下一个soureRow。 任何帮助都会很棒。 我正在尝试让此脚本循环通过工作表4至10,并且如果该行的背景颜色为黄色或红色,并且工作表1没有匹配的值。 将行复制到工作表1的底部。
target = "Sheet1"
For allSheets = 4 To 10
lastTargetRow = Sheets(target).Range("A" & Rows.Count).End(xlUp).Row
Sheets(allSheets).Activate
lastCurrentRow = Sheets(allSheets).Range("A" & Rows.Count).End(xlUp).Row
For sourceRow = 2 To lastCurrentRow
If ActiveSheet.Cells(sourceRow, "B").Interior.Color = Yellow Then
For checkRow = 2 To lastTargetRow
If ActiveSheet.Cells(sourceRow, "B").Value <> Sheets(target).Cells(checkRow, "B").Value Then
nRow = Sheets(target).Range("A" & Rows.Count).End(xlUp).Row + 1
For lCol = 1 To 26 'Copy entire row by looping through 6 columns
Sheets(target).Cells(nRow, lCol).Value = Sheets(allSheets).Cells(sourceRow, lCol).Value
Next lCol
End If
Next checkRow
If ActiveSheet.Cells(sourceRow, "B").Interior.Color = Red Then
For checkRow2 = 2 To lastTargetRow
If ActiveSheet.Cells(sourceRow, "B").Value <> Sheets(target).Cells(checkRow, "B").Value Then
nRow = Sheets(target).Range("A" & Rows.Count).End(xlUp).Row + 1
For lCol = 1 To 26 'Copy entire row by looping through 6 columns
Sheets(target).Cells(nRow, lCol).Value = Sheets(allSheets).Cells(sourceRow, lCol).Value
Next lCol
End If
Next checkRow2
End If
Next sourceRow
Next allSheets
这可能使您更接近:
Sub Tester()
Const TARGET As String = "Sheet1"
Dim shtTarget As Worksheet, allSheets As Long, nextTargetRow As Long
Dim shtTmp As Worksheet, lastCurrentRow As Long, sourceRow As Long
Dim clr As Long, f As Range, bCell As Range
Dim myYellow As Long '<<EDIT
myYellow = RGB(255, 235, 156)
Set shtTarget = Sheets(TARGET)
nextTargetRow = shtTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1
For allSheets = 4 To 10
Set shtTmp = Sheets(allSheets)
lastCurrentRow = shtTmp.Cells(Rows.Count, "A").End(xlUp).Row
For sourceRow = 2 To lastCurrentRow
Set bCell = shtTmp.Cells(sourceRow, "B")
clr = bCell.Interior.Color 'get the color
'is yellow or red?
If clr = myYellow Or clr = vbRed Then
'look in colB on Target sheet for the value from source
Set f = shtTarget.Columns(2).Find(bCell.Value, lookat:=xlWhole)
If f Is Nothing Then
'ColB value is not already listed
shtTarget.Cells(nextTargetRow, 1).Resize(1, 26).Value = _
shtTmp.Cells(sourceRow, 1).Resize(1, 26).Value
nextTargetRow = nextTargetRow + 1
End If
End If
Next sourceRow
Next allSheets
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.