[英]VBA to import multiple CSV files into multiple sheets in excel
I am working to make an automated template that imports multiple csv files into multiple sheets in an excel template that I have created. 我正在制作一个自动模板,在我创建的Excel模板中将多个csv文件导入多个工作表。
So far I have one sheet in the template that has a table named Results and a column named Login ID. 到目前为止,我在模板中有一个工作表,其中有一个名为Results的表和一个名为Login ID的列。 I wrote the following script to automatically create sheets and name them.
我编写了以下脚本来自动创建工作表并命名它们。 My table data starts on row 7.
我的表数据从第7行开始。
Sub Prepare_Report()
Dim WS As Worksheet
' Go to the results page
Sheets("Results Page").Select
' Create all additional sheets from Login ID field in the results table
Dim N As Long, I As Long
N = Range("Results[Login ID]").Rows.Count + 6
For I = 7 To N
aName = Worksheets("Results Page").Range("C" & I).Value
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
WS.Name = aName
Next I
Each CSV file I have to import is named after one of the Login ID's as well, and they will be located in the same folder as the template I am creating. 我必须导入的每个CSV文件也以其中一个登录ID命名,它们将与我正在创建的模板位于同一文件夹中。
the CSV files will need a slight modification to separate the date and time from the first column. CSV文件需要稍加修改才能将日期和时间与第一列分开。
' Columns("A:A").Select
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Columns("B:B").Select
' Selection.Cut Destination:=Columns("A:A")
' Columns("A:A").Select
' Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
' FieldInfo:=Array(Array(0, 1), Array(10, 1)), TrailingMinusNumbers:=True
' Columns("A:A").Select
' Selection.NumberFormat = "mm/dd/yy;@"
' Columns("B:B").Select
' Columns("B:B").EntireColumn.AutoFit
'
Any ideas if I am on the right track or how to best solve my CSV import woes would be much appreciated. 任何想法,如果我在正确的轨道或如何最好地解决我的CSV导入困境将非常感激。
This will do what you want! 这将做你想要的!
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:="CSV Files (*.csv), *.csv", _
MultiSelect:=True, Title:="CSV 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.