使用文件名重命名工作表

Question

说明：我想做的是允许用户通过浏览选择excel文件，然后将数据从表3复制到所选文件中，然后粘贴到当前工作簿sheet2（名称为Raw data（STEP 1））。从当前工作簿sheet2的结果中，我想将数据复制到一个新的工作表中，并希望基于其文件名而不是完整字符串而是仅以M 100P 1这样的结尾来重命名工作表。

我的文件名示例（只是一个虚拟文件），其中包含将近20个文件：

abcd_19-10-10_17-26_efgh-ijkl-02_ww1_line0_M 100P 1
abcd_19-10-10_18-33_efgh-ijkl-02_ww1_line0_M 100P 16

目前，我正在使用输入框重命名工作表，如下所示：

Private Sub OpenWorkBook_Click()

Dim myFile As Variant
Dim OpenBook As Workbook

Application.ScreenUpdating = False

myFile = Application.GetOpenFilename(Title:="Browse your file", FileFilter:="Excel Files(*.xls*),*xls*")

If myFile <> False Then
    Set OpenBook = Application.Workbooks.Open(myFile)
    OpenBook.Sheets(3).Range("A2:R3063").Copy
    ThisWorkbook.Worksheets("Raw data(STEP 1)").Range("A3").PasteSpecial xlPasteValues
    OpenBook.Close True

    ThisWorkbook.Sheets(3).Range("A9:O27").Copy
    myVal = InputBox("Enter Sheet Name")
    Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = myVal
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    ThisWorkbook.ActiveSheet.Range("A1:O19").ColumnWidth = 10.8

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If

End Sub

无论如何都可以不使用输入框来做到这一点？

任何帮助将不胜感激

Answer 1

要在末尾添加一张纸并一次性命名，请尝试以下操作：

Thisworkbook.Sheets.Add(After:=Thisworkbook.Sheets(Thisworkbook.Sheets.Count)).Name = "Your sheet name goes here"

或更确切地说：

With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Your sheet name goes here"
End with