创建一个按钮，为新工作表生成指定列

Question

我上周刚发布了一个问题。问题是在列表中找到丢失的单元格。这是帖子链接Button click find empty cell 基于前一个问题，我想补充一些新功能。 红色列是必填字段，绿色是可选字段。 我想添加一个新列并创建一个按钮，该按钮可以为新工作表生成所有必填字段。

如您所见，有一个新列和一个新按钮已创建。 现在，我想使用＆＃34;生成按钮＆＃34;将所有必填（红色）字段生成为新的工作表调用＆＃34; important＆＃34;。但是，我有一个条件依赖于列K来决定我将生成哪一行数据。如果col K YES ，那么如果col K No ，它将生成该行数据，那么我将不会将该行生成到新工作表。

我的问题是如何生成新的工作表并将这些必填字段提取到新工作表中，其中包含是或否条件  谢谢

这是我的代码：

Private Sub CommandButton2_Click()

Dim rng As Range
Dim selected As Range
Dim newws As Worksheet
Dim yesno As Range
Dim lastrow As Long
Dim justify As Boolean

lastrow = Range("B3").End(xlDown).Row

Set rng = Range("B3:J" & lastrow)
Set yesno = Range("K3:K" & lastrow)

Worksheets("Important").Add after:=Sheets(Worksheets.Count)
Set wks = ActiveSheet
 For Each selected In rng
If rng.Cells.Value = "Yes" Then
justify = True
Worksheets("Important").Copy
Else
If rng.Cells.Value = "No" Then
justify = False

Set newws = Nothing
End If
End If
Next
End Sub

Answer 1

有几件事：

1. 您正在B列而不是K列循环。For Each循环应该For each selected in yesno不是rng。

2. 创建工作表的方法无效。我喜欢将它们分成两行。我声明了一个工作表变量'tws'。

   设置tws = Worksheets.Add（在：= Sheets（Worksheets.Count）之后） tws.Name =（“重要”）

3. 复制/粘贴行不正确。语法为range(source).copy range(destination)

所以以下所有人都会这样做：

Private Sub CommandButton2_Click()

Dim rng As Range
Dim ss As Range, cel As Range
Dim yesno As Range
Dim lastrow As Long
Dim justify As Boolean
Dim tws As Worksheet
Dim tlr&, i&

Set wks = Sheets("Sheet1") 'Change this to the worksheet with the data
With wks
    lastrow = .Range("B3").End(xlDown).Row

    Set yesno = .Range("K3:K" & lastrow)

    Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count))
    tws.Name = ("Important")
    Set rng = Union(.Range("B3"), .Range("D3"), .Range("E3"), .Range("H3"), .Range("I3"))
    rng.Copy tws.Range("B1")
    For Each ss In yesno
        If LCase(ss.Value) = "yes" Then
            'set rng to the 5 cells desired.
            Set rng = Union(.Range("B" & ss.Row), .Range("D" & ss.Row), .Range("E" & ss.Row), .Range("H" & ss.Row), .Range("I" & ss.Row))
            tlr = tws.Range("B" & tws.Rows.Count).End(xlUp).Offset(1).Row 'find next empty row on target sheet
            rng.Copy tws.Cells(tlr, "B") 'Change to starting column desired.
            justify = True 'not sure what this is for.
        ElseIf LCase(ss.Value) = "no" Then
            justify = False 'not sure what this is for.
        End If
    Next
End With
End Sub

我将selected更改为ss只是为了远离selection，所以我不需要输入那么多内容。

我还将rng声明为要复制的必需单元格。

编辑添加标题