宏以提示工作表并复制所选工作表以打开工作簿

时间:2015-04-28 17:21:54

标签: excel vba

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

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

0 个答案:

没有答案
相关问题