Error in copying Word tables into a new worksheet

[JohanPoulsen]

I am working with a macro, where I select a folder, then the macro is to open 4 different word files, stored in subfolders, copy a table in each into a new worksheet in Excel.

It works for the first Word file, then it seems to skip the next two, after which it pastes the table from the last file into "Sheet1" intstead of the new worksheet.

This is my code (warning: it is not pretty):

Sub SelectFolderPaste()
    Dim diaFolder As FileDialog
    Dim Dansk As String
    Dim Historie As String
    Dim Matematik As String
    Dim NF As String
    Dim Path As String
    Dim vFiles
    Dim oWord As Object
    Dim iFile As Integer
    Dim R As Range


    Dansk = "\Dansk\Formativ feedbackskema dansk.docx"
    Historie = "\Historie\Formativ feedbackskema historie.docx"
    NF = "\Nf\Formativ feedbackskema nf.docx"
    Matematik = "\Matematik\Formativ feedbackskema matematik.docx"
    
    ' Open the file dialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show


    If diaFolder = "False" Or diaFolder = "" Then
        
        Exit Sub
    
    Else
    
    Path = diaFolder.SelectedItems(1)
    
    vFiles = Array(Path & Dansk, Path & Historie, Path & Matematik, Path & NF)


    Set oWord = CreateObject("Word.Application")
    oWord.Visible = True
    Set R = Worksheets.Add.Range("A1")


        oWord.Documents.Open vFiles(0)
        oWord.ActiveDocument.Tables(1).Select
        oWord.Selection.Copy
        ActiveSheet.Paste R
        Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        oWord.ActiveDocument.Close False
        
        oWord.Documents.Open vFiles(1)
        oWord.ActiveDocument.Tables(1).Select
        oWord.Selection.Copy
        ActiveSheet.Paste R
        Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        oWord.ActiveDocument.Close False


        oWord.Documents.Open vFiles(2)
        oWord.ActiveDocument.Tables(1).Select
        oWord.Selection.Copy
        ActiveSheet.Paste R
        Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        oWord.ActiveDocument.Close False
        
        oWord.Documents.Open vFiles(3)
        oWord.ActiveDocument.Tables(1).Select
        oWord.Selection.Copy
        ActiveSheet.Paste R
        Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        oWord.ActiveDocument.Close False


    oWord.Quit
    Set oWord = Nothing
    ActiveSheet.Columns.AutoFit


    Set diaFolder = Nothing
    
    End If
    
End Sub