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

NRodrigues

New Member
Joined
Jan 12, 2019
Messages
2
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!




 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
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


Code:
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
 
Upvote 0
Thank you very much :laugh:

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!
 
Upvote 0
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top