Force Excel 2019 VBA to import multiple txt file to existing sheet & not seperate wk.book / wk.sheets

[Event2020]

A little bit of a strange one for me as I have experienced this issue before
.
I have a sub which is a file picker.
This allows a user to navigate to a windows folder and select 1 or many text files and then import them into Excel.

Excel is *supposed* to import all selected text files in to an existing single worksheet called "Data import" where I have
sub's that will format and extract the text as required.

This files are also meant to be placed or appended one after each other in alphabetical order with excel placing a blank row colored yellow
in-between each imported for easy identifacation.

That being said, what the VBA is actually doing is importing each text file to a new worksheet out side of the current workbook
making them essentially mini workbooks.

The insert a blank yellow row also does not work as expected but I am more concerned with getting the file import correct.

Any help or hints would be appreciated.

Sub ImportTxtDocuments()
    Dim ws As Worksheet
    Dim i As Integer
    Dim fileDialog As fileDialog
    Dim filePath As String
    Dim fileName As String
    Dim lastRow As Integer
    Dim importedCount As Integer
    
    Set ws = ThisWorkbook.Sheets("Media")
    importedCount = 0
    
    ' Create a FileDialog object as a File Picker dialog box
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    
    With fileDialog
        ' Allow multi-selection of files
        .AllowMultiSelect = True
        ' Filter to only show txt files
        .Filters.Add "Text Files", "*.txt"
        ' Show the File Picker dialog box
        If .Show = -1 Then
            For i = 1 To .SelectedItems.Count
                filePath = .SelectedItems(i)
                fileName = Dir(filePath)
                
                ' Check if only one file has been selected
                If .SelectedItems.Count = 1 Then
                    ' Import the file to the first row
                    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                    Workbooks.OpenText fileName:=filePath, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1),                                      TrailingMinusNumbers:=True
                    importedCount = importedCount + 1
                Else
                    ' Import files in A-Z alphabetical order with yellow row in between
                    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                    Workbooks.OpenText fileName:=filePath, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1),                                     TrailingMinusNumbers:=True
'Not working        Range("A1" & lastRow + 1).Interior.Color = RGB(255, 255, 0) ' Yellow
                    importedCount = importedCount + 1
                End If
            Next i
        End If
    End With
    
    ' Display a message box with the count of imported txt files for reference
    MsgBox importedCount & " txt files have been successfully imported.", vbInformation
End Sub

 

[Domenic]

Try the following code...

Option Explicit

Sub ImportTxtDocuments()

    Dim fileNames As Variant
    Dim sourceWorkbook As Workbook
    Dim destinationWorksheet As Worksheet
    Dim importedCount As Long
    Dim fileNameIndex As Long
    Dim nextRow As Long
    
    fileNames = Application.GetOpenFilename( _
                    FileFilter:="Text Files (*.txt), *.txt", _
                    Title:="Open", _
                    ButtonText:="Open", _
                    MultiSelect:=True)
                    
    If Not IsArray(fileNames) Then Exit Sub
    
    Application.ScreenUpdating = False
    
    SortOneDimensionalArray fileNames, XlSortOrder.xlAscending  'or xlsortorder.xlDescending to sort in descending order
    
    Set destinationWorksheet = ThisWorkbook.Sheets("Media")
    
    destinationWorksheet.Cells.Clear

    importedCount = 0
    For fileNameIndex = LBound(fileNames) To UBound(fileNames)
        Workbooks.OpenText fileName:=fileNames(fileNameIndex), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
        Set sourceWorkbook = ActiveWorkbook
        With destinationWorksheet
            If importedCount = 0 Then
                sourceWorkbook.Worksheets(1).UsedRange.Copy .Range("A1")
            Else
                nextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                .Cells(nextRow, "A").Interior.Color = RGB(255, 255, 0) ' Yellow
                nextRow = nextRow + 1
                sourceWorkbook.Worksheets(1).UsedRange.Copy .Cells(nextRow, "A")
            End If
        End With
        sourceWorkbook.Close SaveChanges:=False
        importedCount = importedCount + 1
    Next fileNameIndex
    
    Application.ScreenUpdating = True

    ' Display a message box with the count of imported txt files for reference
    MsgBox importedCount & " txt files have been successfully imported.", vbInformation
    
End Sub

 Private Sub SortOneDimensionalArray(ByRef fileNames As Variant, Optional ByVal sortOrder As XlSortOrder = XlSortOrder.xlAscending)

    Dim fileName1 As String
    Dim fileName2 As String
    Dim temp As String
    Dim i As Long
    Dim j As Long
    
    If UBound(fileNames) = LBound(fileNames) Then Exit Sub
    
    If sortOrder = xlAscending Then
        For i = LBound(fileNames) To UBound(fileNames) - 1
            For j = i + 1 To UBound(fileNames)
                fileName1 = getBaseFileName(fileNames(i))
                fileName2 = getBaseFileName(fileNames(j))
                If fileName1 > fileName2 Then
                    temp = fileNames(i)
                    fileNames(i) = fileNames(j)
                    fileNames(j) = temp
                End If
            Next j
        Next i
    Else
        For i = LBound(fileNames) To UBound(fileNames) - 1
            For j = i + 1 To UBound(fileNames)
                fileName1 = getBaseFileName(fileNames(i))
                fileName2 = getBaseFileName(fileNames(j))
                If fileName1 < fileName2 Then
                    temp = fileNames(i)
                    fileNames(i) = fileNames(j)
                    fileNames(j) = temp
                End If
            Next j
        Next i
    End If
    
End Sub

Private Function getBaseFileName(ByVal fileName As String) As String

    Dim pathSeparator As String
    Dim pos As Long
    
    pathSeparator = Application.pathSeparator
    
    pos = InStrRev(fileName, pathSeparator)
    
    getBaseFileName = Mid(fileName, pos + 1)
    
End Function

Hope this helps!