Excel 基于单元格中的响应运行宏

我是否可以编写一个宏，其中-command按钮将检查a列中的表（类似于下面的表）是否有Yes响应

比如说

A列
回应

• 对
• 没有
• NA
• 对
• 对

B栏 对应的选项卡名称

• 表-001
• 表-002
• 表-003
• 表-004
• 表-005

如果响应为“是”，则应-运行“CopysheetandRename”，并根据下面B列-宏中的选项卡名称命名选项卡 我知道我必须删除输入框，并以某种方式将其替换为循环函数中B列（即“Tab-001”）中的tan名称。然而，我不知道如何才能做到这一点

Public Sub CopySheetAndRename()
Dim newName As String

On Error Resume Next
newName = InputBox("Enter the name for the copied worksheet")

If newName <> "" Then
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = newName
    Range("$D$3").Value = newName
End If

Dim n As Name
For Each n In ActiveWorkbook.Names
n.Visible = True
Next n

Dim numrow
numrow = Range("F16").Value

If IsNumeric(numrow) Then

For i = 1 To numrow

Call INRW

Next i

End If

End Sub'

Public子CopySheetAndRename（）
将newName设置为字符串
出错时继续下一步
newName=InputBox（“输入复制工作表的名称”）
如果新名称为“”，则
ActiveSheet.Copy After:=工作表（Sheets.Count）
出错时继续下一步
ActiveSheet.Name=newName
范围（“$D$3”）。值=新名称
如果结束
以n为名称
对于ActiveWorkbook.name中的每个n
n、 可见=真
下一个
暗夜
numrow=范围（“F16”）。值
如果是数字（numrow），则
对于i=1到numrow
呼叫INRW
接下来我
如果结束
结束Sub'

最终，我试图实现的是一个命令按钮，它将通过命令按钮和现有宏“CopySheetAnderName”的使用帮助我生成Tab-001、Tab-004、Tab-005

希望这是有意义的，并为这个冗长的问题感到抱歉

编辑：

我已经在下面的google drive链接中上传了原始xlsm：
[连结] 文件中的“响应”位于O列，相应的选项卡名称位于C列。“Copysheetandrename”按钮位于“模板”选项卡中，请尝试以下代码：

Private Sub CommandButton1_Click() 'Replace with your Command Button name
Dim i As Long, lastRow As Long

With Me
    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastRow
        If .Cells(i, 1).Value2 = "Yes" Then Call CopySheetAndRename(.Cells(i, 2).Value2)
    Next i
End With

End Sub

为此，您需要更改现有程序，如下所示：

Public Sub CopySheetAndRename(Optional newName As String = "")

On Error Resume Next
If newName = "" Then newName = InputBox("Enter the name for the copied worksheet")

If newName <> "" Then
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = newName
    ActiveSheet.Range("$D$3").Value = newName
End If

Dim n As Name
For Each n In ActiveWorkbook.Names
    n.Visible = True
Next n

Dim numrow
numrow = Range("F16").Value

If IsNumeric(numrow) Then

For i = 1 To numrow
    Call INRW
Next i

End If

End Sub

请尝试以下代码：

Private Sub CommandButton1_Click() 'Replace with your Command Button name
Dim i As Long, lastRow As Long

With Me
    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastRow
        If .Cells(i, 1).Value2 = "Yes" Then Call CopySheetAndRename(.Cells(i, 2).Value2)
    Next i
End With

End Sub

为此，您需要更改现有程序，如下所示：

Public Sub CopySheetAndRename(Optional newName As String = "")

On Error Resume Next
If newName = "" Then newName = InputBox("Enter the name for the copied worksheet")

If newName <> "" Then
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = newName
    ActiveSheet.Range("$D$3").Value = newName
End If

Dim n As Name
For Each n In ActiveWorkbook.Names
    n.Visible = True
Next n

Dim numrow
numrow = Range("F16").Value

If IsNumeric(numrow) Then

For i = 1 To numrow
    Call INRW
Next i

End If

End Sub

---

因此，使用实际数据，如果是/否响应在O列中，而选项卡名称在C列中，我会更改代码如下

Private Sub CommandButton1\u Click（）'替换为您的命令按钮名称Dim i As Long，lastRow As Long替换为ActiveSheet lastRow=.Cells（Rows.Count，1）.End（xlUp）.line For i=1替换为lastRow If.Cells（i，15）.Value2=“Yes”，然后CopySheetAndRename（.Cells（i，3）.Value2）接下来我以End Sub结束

几乎正确，您需要将

lastRow=.Cells（Rows.Count，1）.End（xlUp）.Row

更改为

lastRow=.Cells（Rows.Count，3）.End（xlUp）.Row

。我编辑了我的答案，把这个版本作为一个尝试来避免ActSeriGET。@ TommyLi，如果你的问题被解决了，请考虑将问题标记为答案。在没有使用实际数据参考文件O的情况下，通过文本解释我试图实现的目标有点困难。如果是/否响应在O列中，选项卡名称在C列中，我会按如下方式更改代码

Private Sub CommandButton1\u Click（）'替换为您的命令按钮名称Dim i As Long，lastRow As Long替换为ActiveSheet lastRow=.Cells（Rows.Count，1）.End（xlUp）.line For i=1替换为lastRow If.Cells（i，15）.Value2=“Yes”，然后CopySheetAndRename（.Cells（i，3）.Value2）接下来我以End Sub结束

几乎正确，您需要将

lastRow=.Cells（Rows.Count，1）.End（xlUp）.Row

更改为

lastRow=.Cells（Rows.Count，3）.End（xlUp）.Row

。我编辑了我的答案，把这个版本作为一个尝试来避免ActSeriGET。@ TommyLi，如果你的问题被解决了，请考虑将问题标记为答案。在没有参考文件的情况下，通过文本解释我试图实现的目标有点困难