更改VBA编码以允许在某些单元格包含任何数据时执行命令

Question

我需要帮助找出excel工作簿中VBA编码的正确措辞。当前，如果特定单元格包含单词"，当按下按钮时，我将整行复制到另一张纸上；失败"；。我想将其更改为页面上的下一个单元格，以移动包含任何单词的整行，无论前一个单元格是否显示"；通过"；或"；失败"；。

到目前为止，我的编码是：

a = Worksheets("Extinguisher").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Extinguisher").Cells(i, 10).Value = "Fail" Then

Worksheets("Extinguisher").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher").Activate

End If

因此，我需要将其更改为cell(i, 12)而不是cell(i, 10)，并且我希望所述单元格现在能够像下面所做的那样复制包含任何值的行，但不能复制cell(i, 12)中不包含数据的其他行。

希望这对我想做的事情有意义。

所以自从发布后，我在VBA编码中找到了解决方案，见下文，但新的问题已经开始了。我希望VBA代码只在指定工作表的第22行之后查看cells(i, 12)。我试过用"；FirstRow22〃；但这使得VBA代码什么也不做。

a = Worksheets("Extinguisher").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a

If Worksheets("Extinguisher").Cells(i, 12).Value > "" Then

Worksheets("Extinguisher").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher").Activate

End If

我觉得我可能只是错过了这部分之前的一行代码：

If Worksheets("Extinguisher").Cells(i, 12).Value > "" Then

这是对以下评论的补充由FANEDURU：

以下是您所做更改的全部代码。我收到一个"运行时错误"，具体取决于要复制的行数。

Private Sub CommandButton1_Click()
'unprotect sheet
Worksheets("Repairs Sheet").Unprotect Password:="JODA"
a = Worksheets("Extinguisher").Cells(Rows.Count, 1).End(xlUp).Row
For i = 21 To a
If Worksheets("Extinguisher").Cells(i, 12).Value <> "" Then

Worksheets("Extinguisher").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher").Activate

End If
Next
a = Worksheets("Extinguisher pg2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Extinguisher pg2").Cells(i, 12).Value <> "" Then

Worksheets("Extinguisher pg2").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher pg2").Activate

End If
Next
a = Worksheets("Extinguisher pg3").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Extinguisher pg3").Cells(i, 12).Value = "" Then

Worksheets("Extinguisher pg3").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher pg3").Activate

End If
Next
a = Worksheets("Extinguisher pg4").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Extinguisher pg4").Cells(i, 12).Value <> "" Then

Worksheets("Extinguisher pg4").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher pg4").Activate

End If
Next
a = Worksheets("Extinguisher pg5").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Extinguisher pg5").Cells(i, 12).Value <> "" Then

Worksheets("Extinguisher pg5").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher pg5").Activate

End If
Next
a = Worksheets("Extinguisher pg 6").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Extinguisher pg 6").Cells(i, 12).Value <> "" Then

Worksheets("Extinguisher pg 6").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Extinguisher pg 6").Activate

End If
Next
a = Worksheets("E-Lights").Cells(Rows.Count, 1).End(xlUp).Row
For i = 21 To a
If Worksheets("E-Lights").Cells(i, 12).Value <> "" Then

Worksheets("E-Lights").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("E-Lights").Activate

End If
Next
a = Worksheets("E Lights pg2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("E Lights pg2").Cells(i, 11).Value <> "" Then

Worksheets("E Lights pg2").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("E Lights pg2").Activate

End If
Next
a = Worksheets("E-Lights pg3").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("E-Lights pg3").Cells(i, 11).Value <> "" Then

Worksheets("E-Lights pg3").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("E-Lights pg3").Activate

End If
Next
a = Worksheets("E Lights pg4").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("E Lights pg4").Cells(i, 11).Value <> "" Then

Worksheets("E Lights pg4").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("E Lights pg4").Activate

End If
Next
a = Worksheets("E Lights pg5").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("E Lights pg5").Cells(i, 11).Value <> "" Then

Worksheets("E Lights pg5").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("E Lights pg5").Activate

End If
Next
a = Worksheets("E Lights pg6").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("E Lights pg6").Cells(i, 11).Value <> "" Then

Worksheets("E Lights pg6").Rows(i).Copy
Worksheets("Repairs Sheet").Activate
b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("E Lights pg6").Activate

End If
Worksheets("Repairs Sheet").Range("A1:N300").Locked = True
'protect the sheet back
Worksheets("Repairs Sheet").Protect Password:="JODA"

Next
Application.CutCopyMode = False

End Sub

再次，运行时错误似乎根据我要求编码复制到"；修理单"；。

Answer 1

请尝试下一个代码。您应该适当地填充字符串以使要处理的纸张排列(arrSheets(:

Sub copyRowFromManySheets()
Dim shE As Worksheet, shR As Worksheet, lastRE As Long, firstRE As Long, mtch
Dim lastRR As Long, lastCol As Long, arrE, i As Long, rngCopy As Range, arrSheets

arrSheets = Split("Extinguisher,SheetX,SheetY,SheetZ,SheetETC", ",") 'place here the names of your sheets to be processed
Set shR = Worksheets("Repairs Sheet")
firstRE = 22 'the row where the iteration must start

For Each shE In ActiveWorkbook.Sheets                'iterate between all sheets
mtch = Application.match(shE.Name, arrSheets, 0)  'find the iteration sheet in the sheets array
If Not IsError(mtch) Then                         'if it exists in the array:
lastRE = shE.cells(rows.count, 1).End(xlUp).row 'calculate last row
lastCol = shE.UsedRange.rows.count              'calculate last col

arrE = shE.Range(shE.cells(firstRE, 1), shE.cells(lastRE, lastCol)).value 'place the range to be processed in an array (to wark faster)

For i = 1 To UBound(arrE)                        'iterate between the array elements
If arrE(i, 12) <> "" Then                     'if column 12 row value is not nothing
If rngCopy Is Nothing Then                'if the range to be copied has not been Set
Set rngCopy = shE.Range(shE.cells(i, 1), shE.cells(i, lastCol))
Else
Set rngCopy = Union(rngCopy, shE.Range(shE.cells(i, 1), shE.cells(i, lastCol))) 'make a union between the existing range and the new row
End If
End If
Next i
If Not rngCopy Is Nothing Then                      'if the range to be copied is Set
lastRR = shR.cells(rows.count, 1).End(xlUp).row 'calculate the target last row
'copy all the range at once (much faster then copying of each row) and make the variable Nothing
rngCopy.Copy Destination:=shR.cells(lastRR + 1, 1): Set rngCopy = Nothing
End If
End If
Next shE
End Sub