VBA Import all .csv files from a folder won't work-CodePudding

I'm trying to create a macro in excel that will import .csv files from different folders into individual sheets. The code I'm using is copied from another workbook where it imports a table like A2:M10 but when I tried adapting it to this new workbook (which will import single row csv files) it compiles and runs but doesn't import anything

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

It repeats for 6 different sheets but none of them work.

I've played with small changes in the code with nothing happening. Most of this code I found online to begin with so I don't have a strong grasp on how it works.

CodePudding user response：

xSht is the active sheet so the copy is to itself. Qualify the ranges to the relevant workbook.

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