Excel VBA将带有复选框的行中的单元格复制到另一个工作簿中

时间:2018-08-11 19:07:24

标签: excel vba checkbox copy-paste

我有一个工作簿,其中一个表从第8行开始。在第8、9和10行中最后一个表列的右侧,我有一个复选框,分别称为CHK8,CHK9和CHK10。隐藏复选框,直到在C8,C9和/或C10中输入值为止。这些单元格中的任何一个单元格中的值都会使该行的复选框可见。在第7行中,我有一个复选框(称为“ chkAll”),用于选中所有可见的复选框。我想要一个代码,如果选中某行,用户可以单击一个按钮(称为“ CommandButton5”),然后某些单元格将被复制并粘贴到另一个工作簿中。在我拥有的代码中,“数据表”是C列,在我要打开的工作簿中,“数据表”是Q列。我希望选中任何行以将C列中的值传输到Q列。到目前为止,这段代码打开了我拥有的模板文件,但是没有将C中的值传输到Q。

'Below is a code that will make the check boxes visible if a value is entered in the column for data sheets.
'Check boxes have to prexist. The code below simply makes them visible or invisible depending on if there's a value in the data sheet column for that row. Right nowI have only created check boxes in rows 8, 9, and 10.
'"Target" is being defined by the range C8:C10 which is the column/range for the “data shee”t name.
'Each check box must be labeled "CHK" (without the quotations) followed by the row number that check box is in.
'If you want 150 check boxes to show starting from row 8, you need to label the first check box CHK8 in row 8, the next CHK9 in row 9, and so on and so forth until CHK158 in row 158.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C8:C10")) Is Nothing Then Exit Sub

If Target.Value <> "" Then
    Me.Shapes("CHK" & Target.Row).Visible = True
'If there is a value for data sheet, check box is visible

Else
    Me.Shapes("CHK" & Target.Row).Visible = False
'If there is no value for data sheet, check box is invisible
End If

End Sub

'Below makes it so if the "Check All" button is click, all visible check boxes are checked off.
'The "Check All" button must be called "chkAll" (without the quotation marks).
Private Sub chkAll_click()
    Dim x As Long

    For x = 8 To 10
        If Me.ChkAll.Value = True Then
            Me.OLEObjects("CHK" & x).Object.Value = True

        Else: Me.ChkAll.Value = False
            Me.OLEObjects("CHK" & x).Object.Value = False
        End If
        Next x
End Sub


Private Sub CommandButton5_Click()

Dim CHK As Boolean
Dim WS As Worksheet
Dim wbTarget As Workbook
Dim wbThis As Workbook

Dim LastCellA As Range
Dim LastCellRowNumber As Long

Set searchWS = Worksheets("Ozone Generator Skid")
    With searchWS
        Set LastCellC = .Cells(.Rows.Count, "C").End(xlUp)
        LastCellRowNumber = Application.WorksheetFunction.Max(LastCellC.Row)
End With

Application.CutCopyMode = False
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open("C:\Users\ssonbati\Documents\Manual Valve List Template.xlsx")
wbTarget.Activate
For i = 8 To LastCellRowNumber
    If CHK = True Then
        wbTarget.Worksheets("Manual Valves").Cells(i - 2, "Q").Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, "C").Value
    End If
Next i
End Sub

2 个答案:

答案 0 :(得分:0)

您永远不会为CHK设置值,因为它始终为False。

也许是这样:

For i = 8 To LastCellRowNumber
    'edit: x >> i
    If Me.OLEObjects("CHK" & i).Object.Value = True Then
        wbTarget.Worksheets("Manual Valves").Cells(i - 2, "Q").Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, "C").Value
    End If
Next i

答案 1 :(得分:0)

For i = 8 To 10
CHK = Me.OLEObjects("CHK" & i).Object.Value
If CHK = True Then
wbTarget.Worksheets("Manual Valves").Cells(i - 2, 17).Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 3).Value
End If
Next i

'这有效。我之前在错误的位置输入了“ -2”