如何一鍵匯入多個txt檔到指定的sheet中

我在每個sheet中都錄了一個相同的巨集 每次要匯入txt時要到各個sheet中去按 按鈕來匯入 現在想要改成 只按一次按鈕 就能把我要的多個txt檔匯到指定的sheet中 以下是我錄的巨集 但不知道要怎麼改才能匯入 請幫忙 謝謝

Private Sub CommandButton1_Click()
Dim strFilt As String
Dim strTitle As String
Dim strFname As Variant
Dim i As Integer
Dim strMsg As String

strFilt = "文字檔案,*.txt,"
strTitle = "打開Excel文件"
strFname = Application.GetOpenFilename(FileFilter:=strFilt, Title:=strTitle, MultiSelect:=True)
If Not IsArray(strFname) Then
MsgBox "沒選擇文件!"
Else
For i = LBound(strFname) To UBound(strFname)
strMsg = strMsg & strFname(i) & vbCrLf
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFname(i), Destination:=Range("$A$5"))
.Name = "C"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "\"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=33
Cells.Select
Selection.RowHeight = 10
Selection.ColumnWidth = 5
Rows("19:50").Select
Selection.RowHeight = 0
Rows("76:134").Select
Selection.RowHeight = 0
ActiveWindow.SmallScroll Down:=-69
Columns("P:AS").Select
Selection.ColumnWidth = 0
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
Range("M5").Select
Selection.TextToColumns Destination:=Range("M5"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(8, 2), Array(12, 2)), TrailingMinusNumbers:= _
True
Next
MsgBox "選擇的文件是:" & vbCrLf & strMsg
End If

End Sub
如何一鍵匯入多個txt檔到指定的sheet中
2018-06-27 16:59 發佈
文章關鍵字 TXT檔 sheet
我沒承認我沒仔細看你寫的內容 .....
只是大概知道就是讀 TXT 入塞到指定的sheet中

我的做法是 :

寫個 "要讀的 TXT" 及 "sheet" 對照表
一個一個作 ...
讀進來 "TXT" 放到對應的 "sheet"
大概就是這樣子
內文搜尋
X
評分
評分
複製連結
Mobile01提醒您
您目前瀏覽的是行動版網頁
是否切換到電腦版網頁呢?