宏 - 将由复选框触发的同一行中的某些单元格复制到不同的工作表

Question

需要一些帮助。我有一个模板，可以将数据从不同的程序导出到其中。数据行因导出而异，每次导出都需要一个新工作簿。

目前，我编写了一个“主”宏来清理工作表（格式、文本到数字等），并在每行包含数据的末尾添加复选框。这些复选框链接到一个单元格。操作员完成工作表后，他们将需要为每行“超出规格”的数据选中一个复选框。然后，这些行将被复制到工作簿的下一张工作表中。这是由按钮触发的。当我只想复制“A”到“I”列中的单元格时，我当前的宏除了复制整行数据之外还可以工作。 “J”列和列中的单元格包含不需要复制的数据。

这是我当前的宏，就像我说的那样，复制整行：

Sub CopyRows() 
    Dim LRow As Long, ChkBx As CheckBox, WS2 As Worksheet
    Set WS2 = Worksheets("T2 FAIR (Single Cavity)")
    LRow = WS2.Range("A" & Rows.Count).End(xlUp).Row

    For Each ChkBx In ActiveSheet.CheckBoxes
        If ChkBx.Value = 1 Then
            LRow = LRow + 1
            WS2.Cells(LRow, "A").Resize(, 14) = Range("A" & _
            ChkBx.TopLeftCell.Row).Resize(, 14).Value
        End If
    Next
End Sub

Answer 1

在等式的右侧，您的 Range() 对象没有正确限定（带有工作表）。所以，我在这个例子中使用了假的wsX。

此外，我使用了“D”的结尾列 - 但您可以更改为您需要的任何内容。

LRow = LRow + 1
r = ChkBx.TopLeftCell.Row

ws2.Range(ws2.Cells(LRow, "A"), ws2.Cells(LRow, "D")) = wsX.Range( _
            wsX.Cells(r, "A"), wsX.Cells(r, "D"))

或

ws2.Range("A" & LRow & ":D" & LRow) = wsX.Range("A" & r & ":D" & r)

---

From Comment: 模板总是从“A19”中导入的数据开始。当我运行这个宏时，将检查的数据复制到下一个工作表，它从单元格“A18”开始。我不知道为什么。如何指定在下一个工作表上以“A19”开头复制选中的数据？

如果它总是减一，您只需添加 1。我不确定您的布局如何，因此您必须添加到 LRow 或 r。所以要么

ws2.Range("A" & LRow + 1 & ":D" & LRow + 1) = ...

或

... = wsX.Range("A" & r + 1 & ":D" & r + 1)

Answer 2

答案如下：

Sub CopyRows()

    Dim ws1 As Worksheet
    Set ws1 = Worksheets("T1 FAIR (Single Cavity)")

    Dim ws2 As Worksheet
    Set ws2 = Worksheets("T2 FAIR (Single Cavity)")

    Dim LRow As Long
    LRow = ws2.Range("A" & rows.count).End(xlUp).row

    Dim r As Long

    Dim ChkBx As CheckBox
    For Each ChkBx In ws1.CheckBoxes
        If ChkBx.value = 1 Then

            LRow = LRow + 1
            r = ChkBx.TopLeftCell.row

            ws2.Range("A" & LRow + 1 & ":I" & LRow + 1).value = _
            ws1.Range("A" & r & ":I" & r + 1).value

        End If
    Next

End Sub