Rename sheet using their file name

Question

Description: What I am try to do is allow user to select excel file via browse then copy data from sheet 3 in selected file and paste to current workbook sheet2 (which name is Raw data(STEP 1) ). From the result in the current workbook sheet2 I want to copy the data to a new sheet and want to rename the sheet base on their file name but not the full string but just the ending such as M 100P 1.

Example of my file name(just a dummy) & it contains almost 20 file is the folder:

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

For now I am using inputbox to rename the sheet, as my code below:

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

Edited code

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

    WB.Sheets(3).Range("A9:O27").Copy

    With WB
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = myVal = Split(WB.Name, ".")(0)
    .ActiveSheet.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    .ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    .ActiveSheet.Range("A1:O19").ColumnWidth = 10.8
    End With


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

Is there anyways to do that without using the inputbox?

Any help will be appreciate

Answer 1

To add a sheet at the end and name it in one go, try something like:

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

As per your last question, I also mentioned it's best to set a workbook object and reference that:

Dim wb as Workbook: Set wb = ThisWorkbook

This will make the above code written much cleaner:

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

To go a step further and get your current workbook name you can then use:

myVal = wb.Name 'Will get you with extension
myVal = Split(wb.Name, ".")(0) 'Will get you name without extension

And as mentioned in the comments you can then also implement some sort of counter. But as per your current code, there is no loop to do so with. The above comes down to:

Dim wb as Workbook: Set wb = ThisWorkbook

With wb
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Split(wb.Name, ".")(0) & "Your counter goes here"
End with

And on a sidenote (also as per your last question) have a look at this post on SO to start improving your code drastically.