匯入文件

Public i, j, x, y

Sub 新工作表()
'
' 新工作表 Macro
' gmadmin 在 2010/6/11 錄製的巨集
'

Sheets(1).Select
Sheets.Add
End Sub
Sub 複製()


j = y


For i = 2 To j + 1



Sheets(i).Select


If i = 2 Then
Range("A1").Select
Else
Range("A2").Select
End If

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

Next




End Sub


Public Sub 整合()
新工作表
複製
Range("A1").Select
End Sub
Sub 匯入文字()

y = InputBox("請輸入檔案數量")

For x = 1 To y
新工作表


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & x & ".txt", Destination:=Range( _
"A1"))
.Name = "1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Next
整合

End Sub