Question

enter image description here有人可以帮我解决问题吗？

下面是我使用Checkbox宏复制数据的代码。我想修改它以通过Sheet1到Sheet2的复选框移动所选数据。应从源位置（Sheet1）删除源数据。

Sub CopyRows()
    For Each chkbx In ActiveSheet.CheckBoxes
        If chkbx.Value = 1 Then
            For r = 1 To Rows.Count
                If Cells(r, 1).Top = chkbx.Top Then
                    With Worksheets("Sheet2")
                        LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        .Range("A" & LRow & ":I" & LRow) = _
                        Worksheets("Sheet1").Range("A" & r & ":I" & r).Value
                    End With
                    Exit For
                End If
            Next r
        End If
    Next
End Sub

Answer 1

可能只需要进行少量更改，但如果要删除行，请尝试最后一行代码。

Sub CopyRows()

Dim r As Long, LRow As Long

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets("Sheet2")
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":I" & LRow) = _
                    Worksheets("Sheet1").Range("A" & r & ":I" & r).Value
                    Worksheets("Sheet1").Range("A" & r & ":I" & r).ClearContents 'will leave blank cells
                End With
                Exit For
            End If
        Next r
    End If
Next

'line below will delete any rows where column A is blank so you may not want to use this
With Worksheets("Sheet1")
    .Range("A8", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp
End with

End Sub

通过复选框从Sheet1移动选定的数据到Sheet2

1 个答案: