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!
<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!