首页 > 解决方案 > 循环关闭 csv 文件

问题描述

我想从同一个文件夹中打开许多 csv 文件,将数据复制到“collectdatahere.xlsm”,然后关闭 csv 文件并打开下一个。

Subscript out of range即使我以相同的方式打开文件,我也会收到错误消息:

Sub osszefuz()
    Dim Folder As String
    Dim File As String
    Dim wbname As String

    Sheets("Munka1").Range("A2").Select
    Folder = "Z:\project\path"
    File = Dir(Folder & "\*.csv")

    Do While File <> ""
        Workbooks.Open Filename:=Folder & "\" & File, Local:=True
        wbname = Folder & "\" & File
        Range("A2", Range("E2").End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
        Workbooks("collectdatahere.xlsm").Activate
        Selection.PasteSpecial Paste:=xlValues
        Range("A1").End(xlDown).Offset(1, 0).Select
        **Workbooks(wbname).Close savechanges:=False**
        File = Dir
    Loop
End Sub

标签: excelvbacsv

解决方案


你不需要SELECT;试试这段代码,看看它是否符合你的要求:

Sub CopyAllCSV()
    Dim sFile As String
    Dim wsPaste As Worksheet
    Const sFolder As String = "Z:\project\path"
    Set wsPaste = ThisWorkbook.Worksheets("Munka1")
    sFile = Dir(sFolder & "\*.csv")

    Do While sFile <> ""
        With Workbooks.Open(Filename:=sFolder & "\" & sFile, Local:=True)
            With .Worksheets(1)
                .Range("A2", .Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
            End With
            wsPaste.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
            .Close savechanges:=False
        End With
        sFile = Dir
    Loop
End Sub

推荐阅读