☰

循环导入 csv 文件夹时出现额外的空白工作表

tag-icon • tag-icon microsoft-excel vba csv
循环导入 csv 文件夹时出现额外的空白工作表

（这是对类似问题的修订）

我经常将一个包含 .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

也就是说，在第一个导入的工作表之后，它会添加“Sheet2”，然后在下一个导入的工作表之后，它会添加“Sheet3”，依此类推。如何解决？

答案1

更改工作表副本行如下：

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

答案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

相关内容