用于从多个csv中选择特定列并导入到一个工作表的宏

Question

我在一个目录中有多个CSV，我需要选择特定文件而不是整个目录，并且我希望能够选择所需的列（X）并将其导入到单个工作表中！

我已经完成了上面的代码，但我正在努力添加一个输入框，该框应具有选择要从每个CSV中提取的列的功能。 而且，每当我导入CSV时，都不会正确排序。我发现我需要应用此公式""=LEFT(F1;1)&TEXT(SUBSTITUTE(F1;LEFT(F1;1);"";"00") " "，但是知道如何在代码中应用以便重命名.csv文件的任何想法。

Sub ImportCSVsWithReferenceI()

Dim xSht As Worksheet
Dim xWb As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xCount As Long
Dim Newname As String

On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
    xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
Set xSht = ThisWorkbook.ActiveSheet.Add

Newname = InputBox("Name for new worksheet?")
If Newname <> "" Then
    Sheets.Add Type:=xlWorksheet
    ActiveSheet.Name = Newname
 End If
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
End If
Application.ScreenUpdating = False

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

Do While 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
Exit Sub

ErrHandler:
    MsgBox "error"
End Sub

数据示例（有时我想提取列A或B或C或....：

结果示例：