macros提示input工作表并复制选定的工作表打开工作簿

我试图让macros运行:打开一个窗口,并要求文件select; 然后在窗口中input选项卡的名称; 复制标签的内容; 最后将内容粘贴到已打开的工作簿中的现有选项卡上。 (包含macros的button的那个)

Public Sub frm_File_Name_Click() Dim cFileLocation As Variant Dim cFileName As Variant Dim cFileSource As Variant Dim i As Integer Dim iRow As Long Dim cSheetTab As Variant Dim ws As Worksheet Dim Msg, Style, Title, Help, Ctxt, Response, MyString Dim Check, Counter Check = True: Counter = 0 ' Initialize variables. On Error Resume Next 'Msg = "Is there more tabs in this workbook that need to bt entered ?" ' Define message. Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons. Title = "MsgBox Demonstration" ' Define title. Help = "DEMO.HLP" ' Define Help file. Ctxt = 1000 ' Define topic Set ws = Worksheets("worksheet") 'Open Windows folder and select workbook NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls) or (*.xlsx), *.xls", Title:="Please select log file") If NewFN = False Then ' On Cancel MsgBox "Stopping because you did not select a file" Exit Sub Else Workbooks.Open Filename:=NewFN 'Open selected workbook Request form End If cFileSource = ActiveWorkbook.Name 'store open workbook Request form as cFilterSource Workbooks.Open cFileSource 'Do Workbooks(cFileSource).Activate 'cSheetTab = InputBox("Sheet Tab?", "Tab Name") 'Get workbook sheet name 'Application.ScreenUpdating = True Dim x As Integer Sheets(cSheetTab).Activate i = 0 Do i = i + 1 If (Err.Number = 9) Then On Error Resume Next cSheetTab = InputBox("Please enter a Tab label. If after 3 entries of a non-existant tab label, this macro will end. Please enter a correct tab label now", "Tab label Entry Try #" & i) Sheets(cSheetTab).Activate End If If i = 3 Then Check = False NewFN = MsgBox("You have not entered a correct tab for 3 times, this macro will end", vbOKOnly + vbCritical, "This macro is ending") Workbooks(cFileSource).Close SaveChanges:=False Exit Sub End If Loop Until (Err.Number <> 9 Or Check = False) 'check to see if you have a good sheet name or if a wrong tab name has been entered more than three times,(error out of range 9) Application.ScreenUpdating = False fileStr = Application.GetOpenFilename() Worksheets("Sheet1").TextBox1.Value = fileStr Dim wbk1 As Workbook, wbk2 As Workbook Set wbk1 = ActiveWorkbook Set wbk2 = Workbooks.Add(fileStr) wbk2.Sheets(1).Cells.Copy wbk1.Worksheets("Sheet2").Cells(1, 1) End Sub