excel - 如果某些单元格包含任何数据，则更改 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 代码cells(i, 12)仅在指定工作表上的第 22 行之后查看。我试过使用“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

运行时错误似乎再次根据我要求将编码复制到“修复表”的行数而改变。

标签： excelvbatextcopyrow

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