Macro to select specific columns from multiple csv and importing to one worksheet

[NRodrigues]

I have multiple csv in one directory, I need to select specific files instead of the entire directory and I want to be able to select the column that I want and import this to a single worksheet! I have already made the code above but I'm fighting to add a input box that give the capability do select the column that I want to extract from each csv. Moreover, whenever I import the csv there are not sorted correctly. I found out that I need to apply this formula "=LEFT(F1;1)&TEXT(SUBSTITUTE(F1;LEFT(F1;1);"";"00") ", but any idea how to apply in code in order to rename the .csv files.

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, " lucida="" console",="" "liberation="" mono",="" "dejavu="" sans="" "bitstream="" vera="" "courier="" new",="" monospace,="" sans-serif;="" vertical-align:="" baseline;="" box-sizing:="" inherit;="" white-space:="" inherit;"="">Sub ImportCSVsWithReferenceI()

Dim xSht As Worksheet
Dim xWb As Workbook
Dim xStrPath AsString
Dim xFileDialog As FileDialog
Dim xFile AsString
Dim xCount AsLong
Dim Newname AsString

OnErrorGoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect =False
xFileDialog.Title ="Select a folder"
If xFileDialog.Show =-1Then
xStrPath = xFileDialog.SelectedItems(1)
EndIf
If xStrPath =""ThenExitSub
Set xSht = ThisWorkbook.ActiveSheet.Add

Newname = InputBox("Name for new worksheet?")
If Newname <>""Then
Sheets.Add Type:=xlWorksheet
ActiveSheet.Name = Newname
EndIf
Set xSht = ThisWorkbook.ActiveSheet


If MsgBox("Clear the existing sheet before importing?", vbYesNo,"Kutools for Excel")= vbYes Then
xSht.UsedRange.Clear
xCount =1
Else
xCount = xSht.Cells(3, Columns.Count).End(xlToLeft).Column +1
EndIf
Application.ScreenUpdating =False

xFile = Dir(xStrPath &""&"*.csv")

DoWhile xFile <>""
Set xWb = Workbooks.Open(xStrPath &""& xFile)

Rows(1).Insert xlShiftDown
Range("A1")= ActiveSheet.Name

ActiveSheet.UsedRange.Copy xSht.Cells(1, xCount)
xWb.Close False
xFile = Dir
xCount = xSht.Cells(3, Columns.Count).End(xlToLeft).Column +1

Loop
Application.ScreenUpdating =True
ExitSub

ErrHandler:
MsgBox "error"
EndSub</code>



THANK YOU!

 

[DanteAmor]

Let's see if I understood, you need:
- Take specific files
- Select a column of each file
- Copy the column in the new sheet
Then try the following

Sub Import_Csv()
    Dim l1 As Workbook
    Dim h1 As Worksheet
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets.Add(after:=l1.Sheets(l1.Sheets.Count))
    '
    Newname = InputBox("Name for new worksheet?")
    If Newname <> "" Then h1.Name = Newname
    '
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "select specific CSV files"
        .Filters.Add "Csv files", "*.csv"
        .AllowMultiSelect = True
        .InitialFileName = "c:\trabajo\shares\" 'ThisWorkbook.Path & "\"
        If Not .Show Then Exit Sub
        '
        j = 1
        For Each arch In .SelectedItems
            Set l2 = Workbooks.Open(arch)
            Set h2 = l2.Sheets(1)
            col = 1
            On Error Resume Next
            Set celda = Application.InputBox("Select the Column ", "SELECT COLUMN TO IMPORT", _
                Default:=Range("A1").Address, Type:=8)
            If Not celda Is Nothing Then col = celda.Column
            On Error GoTo 0
            '
            h2.Columns(col).Copy h1.Columns(j)
            j = j + 1
            l2.Close False
        Next
    End With
    MsgBox "End"
End Sub

 

[NRodrigues]

Thank you very much

If isn't ask to much, it is possible to incorporate for example an inputbox were we will assign the row/column where to start o copy just one time.
Instead to open all the sheets and select one by one? I have to manage for example 100 csv files :/

Thank you again!

 

[DanteAmor]

Sub Import_Csv()
    Dim l1 As Workbook
    Dim h1 As Worksheet
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets.Add(after:=l1.Sheets(l1.Sheets.Count))
    '
    Newname = InputBox("Name for new worksheet?")
    If Newname <> "" Then h1.Name = Newname
    '
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "select specific CSV files"
        .Filters.Add "Csv files", "*.csv"
        .AllowMultiSelect = True
        .InitialFileName = "c:\trabajo\shares\" 'ThisWorkbook.Path & "\"
        If Not .Show Then Exit Sub
        '
        col = 1
        On Error Resume Next
        Set celda = Application.InputBox("Select the Column ", "SELECT COLUMN TO IMPORT", _
            Default:=Range("A1").Address, Type:=8)
        If Not celda Is Nothing Then col = celda.Column
        On Error GoTo 0
        j = 1
        For Each arch In .SelectedItems
            Set l2 = Workbooks.Open(arch)
            Set h2 = l2.Sheets(1)
            '
            h2.Columns(col).Copy h1.Columns(j)
            j = j + 1
            l2.Close False
        Next
    End With
    MsgBox "End"
End Sub