Question

我可以在其中写一个宏吗-命令按钮将检查表（类似于下面的表）中A列中的是响应

例如

A列
响应

是
否
不适用
是
是

B列相应的标签名称

标签-001
标签-002
标签-003
标签-004
标签-005

如果响应为“是”，则应-运行'CopysheetandRename'并根据B列中的标签名称-下方的宏命名标签我知道我必须删除输入框，并以某种方式将其替换为循环功能中B列中的棕褐色名称（即“ Tab-001”）。但是我不确定该怎么做。

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'

我最终想要实现的是一个命令按钮，它将帮助我通过命令按钮并使用现有的宏“ Copysheetandrename”来生成Tab-001，Tab-004，Tab-005

希望这个问题很有意义，很抱歉

编辑：

我已将原始xlsm上传到下面的Google驱动器链接中：
[链接] https://drive.google.com/open?id=1fpgqlyDN72OC6S9NOh_MTh5Ur4ZKWz46 在文件中，“响应”在O列中，相应的选项卡名称在C列中。“ Copysheetandrename”的按钮位于“模板”选项卡中

Answer 1

尝试以下代码：

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

编辑：已更新以适合OP数据集：

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

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

    End Sub

根据单元格中的响应运行宏

1 个答案: