我想导入CSV文件到Excel使用VBA文件

Question

我有一个导入多个CSV文件，以Excel中的代码。此代码工作正常，但我应该编辑多一点。我需要A1复制和粘贴固定的范围，例如，每个CSV文件的C10并粘贴在主Excel文件。其实，我有多个CSV文件，我需要从一个CSV文件中的数据复制到粘贴在一个已经粘贴以前的数据。我是新来的VBA和需要帮助。谢谢

我试图声明一个固定范围。但它似乎是不正确的。我不明白的是，线究竟。

ActiveSheet.UsedRange.Copy xSht.Range("D" & Rows.Count).End(xlUp).Offset(1)

Sub ImportCSVsWithReference()
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [DataImporter]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
        Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "DataImporter") = vbYes Then 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("D" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no files csv", , "DataImporter"
End Sub

Answer 1

你的代码是相当复杂的，而且似乎很好地工作给我。

在代码中设置FilePicker选择要导入的内容，之后创建一个新的工作表粘贴值，复制和主片粘贴（xSht）

说明：

ActiveSheet.UsedRange.Copy xSht.Range("D" & Rows.Count).End(xlUp).Offset(1)

“Activesheet.UsedRange.Copy”意味着您将第一行复制到被填充最后一列（换句话说，你的整个表），并复制到剪贴板

“xSht.Range（” d“＆Rows.Count）.END（xlUp）.Offset（1）”，意味着你去你的主片和计数填写d柱（可能需要一列中的所有行，以避免空白寄存器），以及去年底，偏移+1，换句话说，“新线”。

但是，做这样将粘贴d列的新数据，但你说要放一列。

要做到这一点，把上面一行：

ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)

或者如果你的A是不可信

ActiveSheet.UsedRange.Copy xSht.Range("D" & Rows.Count).End(xlUp).Offset(1, -3)