Importing excel form and adjust worksheet

[Dutchmaste]

I currently have the following macro. But instead of importing it into Worksheet "Import" I would like it to create a worksheet with the name of the excel file without the extention and to import it into that sheet. I know it is possible and tried to implement from others asked on this forum but can't figure it out.

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
   
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A5:I200").Copy
        ThisWorkbook.Worksheets("Import").Range("A1").PasteSpecial xlPasteValues
        OpenBook.Close False
        End If

End Sub

 

[Joe4]

As long as the only period in the file name preceeds the extension, try this:

Sub Get_Data_From_File()

    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wbName() As String
    Dim wsName As String
    Application.ScreenUpdating = False
  
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
'       Get name of workbook for name of sheet
        wbName = Split(OpenBook.Name, ".")
        wsName = wbName(0)
'       Create new sheet in ThisWorkbook
        ThisWorkbook.Sheets.Add.Name = wsName
'
        OpenBook.Sheets(1).Range("A5:I200").Copy
        ThisWorkbook.Worksheets(wsName).Range("A1").PasteSpecial xlPasteValues
        OpenBook.Close False
    End If

End Sub