将文本文件导入Excel并创建主工作簿

时间:2016-01-16 04:56:11

标签: excel vba excel-vba

我是一名研究生,我收集了大量存储在txt文件中的数据。我想以固定宽度导入文本文件,列a,b和c都是12,然后将这些文件保存为excel文件,然后将它们移动到主工作簿中。我发现以下代码可用于制作主工作簿,但不会按数字顺序导入它们。

我正在使用Microsoft 2010。

Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\Users\Kyle\Desktop\Scan Rate Study 1-14-16"
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

考虑使用FSO对象遍历MyPath目录并复制.xls个文件。目前,您的设置正在导入位于目录中的所有Excel文件:

Sub Merge2MultiSheets()
    Dim MyPath As String
    Dim wbDst As Workbook, wbSrc As Workbook, wsSrc As Worksheet
    Dim fso As Object, olFolder As Object, olFile As Object

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\Users\Kyle\Desktop\Scan Rate Study 1-14-16"

    Set wbDst = Workbooks.Add(xlWBATWorksheet)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set olFolder = fso.GetFolder(MyPath)

    For Each olFile In olFolder.Files
        If Right(olFile.Name, 4) = ".xls" Then

            Set wbSrc = Workbooks.Open(olFile.Name)
            Set wsSrc = wbSrc.Worksheets(1)
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
            wbSrc.Close False

        End If
    Next olFile

    wbDst.Worksheets(1).Delete
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Set olFile = Nothing
    Set olFolder = Nothing
    Set fso = Nothing
End Sub