根据行号将 Sheet1 中第 B:D 列的单元格复制到 Sheet2 中的 C:E

Question

我有一个作品sheet (Sheet2)，其中在不同行号的第 B:D 列粘贴了行。

这些行号实际上与工作sheet (Sheet1) 中的行号相对应，它们是空白的，我希望将单元格动态粘贴到列 C:E.

我有以下代码，它允许我根据文本值 = "LAW" 从 Columns 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 中突出显示的点。如果有一种方法可以动态地说 If Text in Column B on Sheet2 = LAW 然后将该行（从列 B 到 D）复制到 Sheet1 中的等效行。在我的示例中，我有两个发生这种情况的实例。

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

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 个 sheet 的情况下工作正常，但它在 N = .Cells(Rows.Count, "B").End(xlUp).row 引用 WSD3 的第二个脚本上失败，运行时间错误为“91”。通过逐步执行代码，我发现如果将鼠标悬停在范围上，则 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

根据行号将 Sheet1 中第 B:D 列的单元格复制到 Sheet2 中的 C:E

Copying Cells from Column B:D in Sheet1 to C:E in Sheet2 based on Row Number

excel

excel-2016

vba