Импорт нескольких файлов CSV при добавлении имени файла для каждого импортируемого файла

Question

Я пытался импортировать несколько файлов CSV, каждый файл имеет уникальное имя. Я пытаюсь сделать следующее: добавить столбец с именами файлов, заполненными до конца для каждого импортированного файла.

Sub ImportMultipleCSV()

Dim myfiles
Dim i As Integer
Dim j As Integer
Dim Answer

myfiles = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)


    If IsArray(myfiles) Then
    Answer = MsgBox("Delete Files after Import?", vbYesNo + vbQuestion)
        For i = LBound(myfiles) To UBound(myfiles)
            With ActiveSheet.QueryTables.Add(Connection:= _
                "TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0))
                .RefreshStyle = xlOverwriteCells
                .AdjustColumnWidth = True
                .TextFileStartRow = 2
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .Refresh

              'add file name to Seperate column

             Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = myfiles(i)
**^^ this line only adds the file name, but I want to fill down.**


            End With

            If Answer = vbYes Then
                Kill myfiles(i)
            End If
        Next i

    Else
        MsgBox "No File Selected"
    End If


Dim xConnect As Object
    For Each xConnect In ActiveWorkbook.Connections
        If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
    Next xConnect


'Range("C:C,E:E,G:G").Delete


End Sub

Это мой выходной файл, который я пытаюсь достичь.

Любая помощь приветствуется. Большое вам спасибо!

Answer 1

Изменить это:

Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = myfiles(i)

к этому:

Range(Range("H" & Rows.Count).End(xlUp).Offset(1), Range("A" & Rows.Count).End(xlUp).Offset(0,7)).Value = myFiles(i)