我试图让宏运行:打开一个窗口并要求文件选择;然后在窗口中键入选项卡的名称;复制标签的内容;最后将内容粘贴到我打开的工作簿中的现有选项卡中。 (包含宏按钮的那个。)
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