Question

我有一个VBA（Excel 2010）代码。它导入多个csv文件并将它们粘贴到不同的工作表中。但它不会将数据导入到执行代码的当前工作簿中。它打开了一个新工作簿并完成了工作。

我希望能够通过命令按钮运行此代码并将数据导入活动工作簿。

任何建议我应该加入哪些变化？

非常感谢您的建议。

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String
On Error GoTo ErrHandler
    Application.ScreenUpdating = False
sDelimiter = "|"
FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.csv), *.csv", _
      MultiSelect:=True, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    x = x + 1
While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Answer 1

问题是wbkTemp.Sheets(1).Copy：如果您不提供可选参数Before或After，Excel会在新工作簿中创建副本（请参阅此处的备注） https://msdn.microsoft.com/en-us/library/office/ff837784.aspx）。

您需要先设置对原始工作簿的引用 - 在第一个CSV的开头处更改代码，如下所示：

Set wkbAll = ActiveWorkbook 'moved from a few lines lower down
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wbkTemp.Sheets(1).Copy After:=wkbAll.Sheets(wkbAll.Sheets.Count)

您必须对以后的复制方法进行等效更改

Answer 2

我发现此链接很有用。

Import multiple text files

它适用于我的情况，唯一的例外是我必须选择包含所有相关文件的特定文件夹，而不是单个文件本身。

它也适用于txt文件，因为选项 Workbooks.OpenText FileName

希望它也能帮助那些面临类似问题的人。

此致 asar_k

我希望此VBA代码从当前工作簿中的命令按钮运行

2 个答案: