需要用户输入口令代码

Question

我有一些代码，我发现，我想要什么完美的作品，这是整个工作表从一个工作簿复制到另一个，但我希望定制它，并使其成为一个对我来说更容易一些（所以我不必为所有30张纸重新编码），允许用户准确指定他们要复制的纸张。

  Sub Start() 
      Dim x As Workbook 
      Dim y As Workbook 

      '## Open both workbooks first: 
      Set x = Workbooks.Open("data workbook") 
      Set y = Workbooks.Open("destination workbook") 

      'This is where I would like the user to input the destination sheet in x: 
      x.Sheets("USER INPUT").Range("A1:z28").Copy 

      'Then paste data from x to y: 
      y.Sheets("STATIC SHEET").Range("A1").PasteSpecial 

      'Close x: 
      x.Close 
      End Sub 

我要的是一个弹出框，当宏运行，这将允许用户输入片（位于“数据的工作簿”）的名称复制从信息出现，并会在访问要复制的数据时自动将此输入输入到宏中。

Answer 1

这有@TyMarc的回答纳入您发布的代码，但它也有一个错误处理程序，这样，如果用户输入不正确的名称，它会给一个错误信息，并要求再次。

Sub Start() 
    On Error GoTo ErrorHandler 
    Dim x, y As Workbook 
    Dim inp as String 

    '## Open both workbooks first: 
    Set x = Workbooks.Open("data workbook") 
    Set y = Workbooks.Open("destination workbook") 

Label1: 

    inp = InputBox("Enter the name of the sheet to be copied") 

    'This is where I would like the user to input the destination sheet in x: 
    x.Sheets(inp).Range("A1:z28").Copy 

    'Then paste data from x to y: 
    y.Sheets("STATIC SHEET").Range("A1").PasteSpecial 

    'Close x: 
    x.Close 
    Exit Sub 'This is a crutial part otherwise it will finish the program and continue right into the error handler which will send it back to Label1 and start an infinite loop of death... 
ErrorHandler: 
    MsgBox("The input entered was not the name of a worksheet") 
    Resume Label1: 
End Sub 

Answer 2

你只需创建一个InputBox，InputBox的结果可以存储在一个变量中，就像这样。

Dim mySheet As String 
mySheet = Application.InputBox("Enter a sheet name") 

然后把

x.Sheets(mySheet).Range("A1:z28").Copy 

虽然你需要确保用户输入了一个良好的工作表名称，否则你会得到一个错误。这里是我的建议：

Set wsSheet = Sheets(mySheet) 
If wsSheet Is Nothing Then 
    'prompt the user again 
Else 
    'put your copy logic here 
End If