VBA 从文件夹导入 all.csv 文件不起作用

Question

我正在尝试在 excel 中创建一个宏，将不同文件夹中的 .csv 文件导入到单独的工作表中。 我正在使用的代码是从另一个工作簿复制的，它导入了一个像 A2:M10 这样的表但是当我尝试将它调整到这个新工作簿（它将导入单行 csv 文件）时它编译并运行但不导入任何东西

Sub Missing_Tools_Import()

    Dim xSht As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String

    On Error GoTo ErrHandler
    
    xStrPath = "O:\Process Engineering\Missing Tools\CV2"

    If xStrPath = "" Then Exit Sub
        Worksheets("CV2").Activate
        Set xSht = ThisWorkbook.ActiveSheet
        xSht.UsedRange.Clear
            Application.ScreenUpdating = False
            xFile = Dir(xStrPath & "\" & "*.csv")
            Do While xFile <> ""
            Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
            Columns(1).Insert xlShiftToRight
            Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
            ActiveSheet.UsedRange.Copy xSht.Range("A1:L1").End(xlUp).Offset(1)
            xWb.Close False
            xFile = Dir

        Loop
        Application.ScreenUpdating = True

xStrPath = "O:\Process Engineering\Missing Tools\CV Tower"

    If xStrPath = "" Then Exit Sub
        Worksheets("CV Tower").Activate
        Set xSht = ThisWorkbook.ActiveSheet
        xSht.UsedRange.Clear
            Application.ScreenUpdating = False
            xFile = Dir(xStrPath & "\" & "*.csv")
            Do While xFile <> ""
            Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
            Columns(1).Insert xlShiftToRight
            Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
            ActiveSheet.UsedRange.Copy xSht.Range("A1:L1").End(xlUp).Offset(1)
            xWb.Close False
            xFile = Dir

        Loop
        Application.ScreenUpdating = True

...


    Exit Sub


ErrHandler:
MsgBox "no files csv", , "Kutools for Excel"
End Sub

它重复 6 张不同的工作表，但没有一张有效。

我对代码进行了一些小改动，但没有任何反应。 大部分代码都是我在网上找到的，所以我不太了解它是如何工作的。

Answer 1

xSht是活动工作表，因此副本是针对自身的。 限定相关工作簿的范围。

Option Explicit
Sub Missing_Tools_Import()

    Dim xSht As Worksheet, xWb As Workbook
    Dim xFileDialog As FileDialog, f, r As Long
    Dim xStrPath As String, xFile As String
    
    Application.ScreenUpdating = False
    For Each f In Array("CV2", "CV Tower")
    
        xStrPath = "O:\Process Engineering\Missing Tools\" & f
    
        Set xSht = ThisWorkbook.Worksheets(f)
        xSht.UsedRange.Clear
        r = 1
    
        xFile = Dir(xStrPath & "\" & "*.csv")
        Do While xFile <> ""
        
            Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
            With xWb.Sheets(1)

                .Columns(1).Insert xlShiftToRight
                .Columns(1).SpecialCells(xlBlanks).Value = .Name
                .UsedRange.Copy xSht.Cells(r, "A")
                r = r + .UsedRange.Rows.Count
                
            End With
            xWb.Close False
            xFile = Dir

        Loop
    Next
    Application.ScreenUpdating = True

End Sub