Question

我试图能够选中信息行旁边的复选框，然后单击一个按钮以粘贴到另一张纸上。我在这里可以使用，但是我希望能够选择多个框，然后单击一次按钮将它们粘贴到另一张纸上。

Private Sub CommandButton1_Click()
'TO Bid Numbers

    'BID DATE
    If CheckBox1.Value = True Then Sheets("Bidding").Range("B3").Copy Sheets("Bid Numbers").Range("A1048576").End(xlUp).Offset(1, 0)

    'PROJECT NAME
    If CheckBox1.Value = True Then Sheets("Bidding").Range("C3").Copy Sheets("Bid Numbers").Range("B1048576").End(xlUp).Offset(1, 0)

    'ESTIMATOR
    If CheckBox1.Value = True Then Sheets("Bidding").Range("D3").Copy Sheets("Bid Numbers").Range("C1048576").End(xlUp).Offset(1, 0)

    'OUR PRICE
    If CheckBox1.Value = True Then Sheets("Bidding").Range("E3").Copy Sheets("Bid Numbers").Range("D1048576").End(xlUp).Offset(1, 0)

End Sub

Answer 1

这适用于“表单控件”复选框：

浏览工作表上的每个复选框，查看是否已勾选。如果是这样，请查看TopLeftCell以获取复选框的位置，并将EntireRow添加到最终将其复制并粘贴到第二张纸上的范围。

Sub Test()

    Dim chkBx As Shape
    Dim rngToCopy As Range

    For Each chkBx In ThisWorkbook.Worksheets("Sheet1").Shapes
        If chkBx.Type = 8 Then
            If chkBx.OLEFormat.Object.Value = 1 Then
                If rngToCopy Is Nothing Then
                    Set rngToCopy = chkBx.TopLeftCell.EntireRow
                Else
                    Set rngToCopy = Union(rngToCopy, chkBx.TopLeftCell.EntireRow)
                End If
            End If
        End If
    Next chkBx

    rngToCopy.Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1")

End Sub

Excel VBA：使用复选框选择行并粘贴到其他工作表

1 个答案: