作者：乔山办公网日期：
返回目录：excel表格制作
程序好编抄，只是这样有意义么，导入完毕就清除？知
sub 宏()
dim p,f,st as worksheet
set st=sheets("sheet2")
if st.range("a1")="" then st.range("a1")=" "
p="c:\" '文件夹，你可能需要修改，一定要道以\结尾
f=dir(p & "*.csv")
while f<>""
with workbooks.open(p & f)
.sheets(1).usedrange.copy st.cells(st.usedrange.rows.count+1,1)
.close
end with
f=dir
wend
end sub
以下代码是在原Excel文件后面新增工作表的方法导入CSV文件，每个工作表名对于CSV文件名。CSV文件与运行宏的这个文件在同一个文件夹里。
附件中的代码,参考下就会了
答：以下代码是在原Excel文件后面新增工作表的方法导入CSV文件，每个工作表名对于CSV文件名。CSV文件与运行宏的这个文件在同一个文件夹里e799bee5baa6e4b893e5b19e337。
Sub Demo()
Dim Filename As String
Dim r As Long, c As Integer
Dim txt As String, Char As String * 1
Dim Data
Dim i As Integer
Dim NewSheet As Worksheet
Dim NewCell As Range
On Error Resume Next
Filename = Dir(ThisWorkbook.Path & "\*.CSV")
Do While Filename <> ""
Set NewSheet = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSheet.Name = Filename
Set NewCell = NewSheet.Range("A1")
Open ThisWorkbook.Path & "\" & Filename For Input As #1
r = 0
c = 0
txt = ""
Application.ScreenUpdating = False
Do Until EOF(1)
Line Input #1, Data
For i = 1 To Len(Data)
Char = Mid(Data, i, 1)
If Char = "," Then
NewCell.Offset(r, c) = txt
c = c + 1
txt = ""
ElseIf i = Len(Data) Then
If Char <> Chr(34) Then txt = txt & Char
NewCell.Offset(r, c) = txt
txt = ""
ElseIf Char <> Chr(34) Then
txt = txt & Char
End If
Next i
c = 0
r = r + 1
Loop
Close #1
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub