从B列复制单元格：Sheet1中的D到Sheet2中的E：E基于行号

Question

我有一个工作表（Sheet2），其中列B：D处有不同行号的粘贴行。

这些行号实际上与工作表（Sheet1）中的行号相对应，这些行号是空白的，我希望将单元格动态地粘贴到列C：E中。

我有以下代码，允许我根据文本值=“LAW”从列B：D中复制行，并在Sheet1中粘贴，只要我知道C列中单元格的范围。

我想我要找的是相当于何时找到“LAW”，将该行与Sheet1中的行匹配并粘贴在C列。由于还有其他实例发现“LAW”，因此需要循环这些细胞需要粘贴在适当的细胞范围内。

    Dim WBT As Workbook
    Dim WSD1 As Worksheet
    Dim WSD2 As Worksheet

    Set WBT = Workbooks("Invoices.csv")
    Set WSD1 = WBT.Worksheets("Sheet1")
    Set WSD2 = WBT.Worksheets("Sheet2")


    Set r2 = WSD1.Range("C11")

    With WSD2
        N = .Cells(Rows.Count, "B").End(xlUp).row
        For i = 1 To N
           If .Cells(i, "B").Value = "LAW" Then
                Set r1 = Range(.Cells(i, "B"), .Cells(N, "D"))
                r1.Copy r2
           End If
        Next i
    End With

我发现很难找到一个故障安全的解决方案，但我希望有人可以给我一些指示，我应该怎么做。

下面的示例演示了我想在Sheet2中查找行并将它们粘贴到Sheet1中突出显示的点。如果有一种方法可以动态地说明Sheet2 = LAW上的B列中的文本然后将该行（从列B到D）复制到Sheet1中的等效行。在我的例子中，我有两个发生这种情况的实例。

在@SJR修改脚本成功之后，我遇到了一个问题，即工作簿有很多页。所以我修改了代码并使用了一个函数来测试是否存在工作表（默认为Not）

Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet

If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(sht)
On Error Resume Next
SheetExists = Not sht Is Nothing
End Function

并复制代码如下：

Dim r1 As Range
Dim r2 As Range
Dim N As Long
Set r2 = WSD1.Range("C1:C100")

With WSD2
    If Not SheetExists("Sheet1") Then
        N = .Cells(Rows.Count, "B").End(xlUp).row
                For i = 1 To N
                    If .Cells(i, "B").Value = "LAW" Then
                        Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
                        r1.Copy WSD1.Cells(i, "C")
                    End If
                Next i
    Else
        On Error Resume Next
    End If
End With

With WSD3
    If Not SheetExists("Sheet2") Then
        N = .Cells(Rows.Count, "B").End(xlUp).row
                For i = 1 To N
                    If .Cells(i, "B").Value = "LAW" Then
                        Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
                        r1.Copy WSD1.Cells(i, "C")
                    End If
                Next i
    Else
       On Error Resume Next
    End If
End With

虽然这在工作簿有2张表的情况下可以正常工作，但它会在N = .Cells(Rows.Count, "B").End(xlUp).row引用WSD3且运行时错误为“91”的第二个脚本上出现问题。通过单步执行代码，我发现当你将鼠标悬停在Range ????上时，R1的变量会显示该消息。虽然我试图找出为什么它说变量没有设置但我很困惑。

Answer 1

你能试试吗？认为你在分配r1的行中有一个错误的N.

Sub x()

Dim WBT As Workbook
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet, N As Long

Set WBT = Workbooks("Invoices.csv")
Set WSD1 = WBT.Worksheets("Sheet1")
Set WSD2 = WBT.Worksheets("Sheet2")
Set r2 = WSD1.Range("C11")

With WSD2
    N = .Cells(Rows.Count, "B").End(xlUp).Row
    For i = 1 To N
       If .Cells(i, "B").Value = "LAW" Then
            Set r1 = .Range(.Cells(i, "B"), .Cells(i, "D"))
            r1.Copy WSD1.Cells(i, "C")
       End If
    Next i
End With

End Sub