怎样把许多.csv文件用VBA按要求导入一张excel表里?求各位大神帮忙。。。

怎样把许多.csv文件用VBA按要求导入一张excel表里?求各位大神帮忙。。。

Sub test()
Dim mAry, i As Long, mRow As Long, wb1 As Workbook
Dim wb As Workbook, mPath As String, mFn As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Workbooks.Count > 1 Then MsgBox "关闭其他工作簿后重试!": Exit Sub
'------------设置搜索路径-----------------
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "--------------------------------------请选择源数据文件所在的文件夹-------------------"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count = 0 Then MsgBox "你放弃了操作": Exit Sub
    mPath = .SelectedItems(1)
End With
Workbooks.Add
Set wb1 = ActiveWorkbook
wb1.SaveAs mPath & "\结果" & Format(Now, "yyyymmddhhmmss") & ".xlsx", xlOpenXMLWorkbook
'-------------遍历文件,收集符合要求的数据-----------------
mFn = Dir(mPath & "\*.csv")
Do While mFn <> ""
    If mFn <> ThisWorkbook.Name And Left(mFn, 2) <> "结果" Then
        Set wb = Workbooks.Open(mPath & "\" & mFn)
        mAry = wb.Worksheets(1).[a1].CurrentRegion
        wb.Close 0
        With wb1.Worksheets(1)
            mRow = .Cells(.Rows.Count, 1).End(3).Row
            mRow = IIf(mRow = 1, 1, mRow + 1)
            .Cells(mRow, 1).Resize(UBound(mAry, 1), UBound(mAry, 2)) = mAry
        End With
    End If
mFn = Dir
Loop
wb1.Save
MsgBox "处理完成!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

追问

我这有编好的代码,但是以下两个问题看不懂,求大神给个邮箱我发给你给我看下?
1,首先数据导入后重新保存,vba中的编程语句就打不开看不到了
2,我想问语句中表示导入10m.h,20m.h,30m.h40m.h,50m.h,100m.h,150m.h的文件夹中的各个文件的语句是哪几条,导入下一层目录6点,12点,18点钟各个文件的语句又是哪几条,如果往里添加文件,应该做怎样修改?

追答

+Q
15963970

温馨提示:答案为网友推荐,仅供参考
第1个回答  2015-08-16
说明一下,按要求,是什么意思?
如果就是要个思路,那就简单了,
循环遍历数据所在文件夹,
导入数据,再按你的要求整理数据就好了。本回答被网友采纳
相似回答