Дополнительные бланки рабочих листов в циклическом импорте папки csv-файлов

Question

(Это пересмотр подобного вопроса)

Я часто импортирую папку .csv файлов в активную рабочую книгу (рабочую книгу с макросом), поэтому я хочу автоматизировать это с помощью VBA.

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

Sub ImportCSV()

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select folder of .csv files."
    .Show
    strDir = .SelectedItems.Item(1)
End With

strFile = Dir(strDir & "\" & "*.csv")

Set wbSink = ThisWorkbook

Do While strFile <> ""

    Set wbSource = Workbooks.Open(strDir & "\" & strFile)
    wbSource.Sheets.Copy wbSink.Sheets.Add
    wbSource.Close False
    strFile = Dir()

Loop

End Sub

То есть после первого импортированного листа добавляется "Лист2", затем после следующего импортированного листа добавляется "Лист3" и так далее. Что это за исправление?

Answer 1

Измените строку копирования листа следующим образом:

Do While strFile <> ""
    Set wbSource = Workbooks.Open(strDir & "\" & strFile)
    wbSource.Sheets.Copy wbSink.Sheets(Sheets.Count)
    wbSource.Close False
    strFile = Dir()
Loop

Answer 2

Это будет работать, но он использует копирование / вставку

Sub ImportCSV()

    Dim strFile As String
    Dim strPath As String
    Dim wkb As Workbook

    Application.ScreenUpdating = False

    strPath = "C:\"
    strFile = Dir(strPath & "*.csv")

        Do While strFile <> ""

            Set wkb = Workbooks.Open(strPath & strFile)

            ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)

            wkb.Sheets(1).UsedRange.Copy

            ThisWorkbook.Sheets(Sheets.Count).Range("A1").Paste

            wkb.Close

            strFile = Dir
        Loop

    Application.ScreenUpdating = True

End Sub