How to name new sheets from opened .docx filename

[JohanPoulsen]

Searching the forums I have found this useful code:

Sub GetWordDocContents()
  Dim oWord As Object
  Dim vFiles
  Dim iFile As Integer
  Dim R As Range
  vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
  If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = True
  Set R = Worksheets.Add.Range("A1")
  For iFile = LBound(vFiles) To UBound(vFiles)
    oWord.Documents.Open vFiles(iFile)
    oWord.ActiveDocument.Tables(1).Select
    oWord.Selection.Copy
    ActiveSheet.Paste R
    Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
    oWord.ActiveDocument.Close False
  Next
  oWord.Quit
  Set oWord = Nothing
  ActiveSheet.Columns.AutoFit


End Sub

I want to change it so that it creates an individual sheet for each word wile, while naming each new sheet with part of the wordfiles filename.

Filenames are: "Formativ feedbackskema dansk.docx", "Formativ feedbackskema engelsk.docx", and so on. I want to name each sheet with the last word: "dansk", "engelsk", and so on.

 

[JohanPoulsen]

I forgot to say: The above code opens multiple word documents, copies tables in them, and pastes the tables into a new worksheet in excel.

 

[JohanPoulsen]

I have resolved the issue on my own