マクロ組んでみました。 貼り付け対象セルについては修正が必要かとは思います。 '入力データは１行目のみ 'カンマ編集（CSV化）していない '拡張子は".txt" '要素数は最大１８ Dim FullPath As String Dim FileName As String Dim intLen As Integer Dim intI As Integer Dim strData(18) As String 'ファイルオープンダイアログ表示 FullPath = Application _ .GetOpenFilename("テキスト ファイル (*.txt), *.txt") 'オープンダイアログでファイルが指定されたら処理実行 If FullPath <> "False" Then 'ファイルオープン Workbooks.OpenText FileName:=FullPath, StartRow:=1, DataType:= _ xlFixedWidth, FieldInfo:=Array(0, 2) 'ファイル名取得 FileName = Dir(FullPath) With Workbooks(FileName).Worksheets(Left(FileName, Len(FileName) - 4)) '開いたファイルの1行目に文字列があれば処理 If .Cells(1, 1) <> "" Then '読み込んだファイルの文字数が6の倍数かチェック intLen = Int(Len(.Cells(1, 1)) / 6) If Len(.Cells(1, 1)) = intLen * 6 Then For intI = 1 To intLen '６バイトづつ抽出 strData(intI) = Mid(.Cells(1, 1), 6 * intI - 5, 6) If IsNumeric(strData(intI)) = False Then '切り出したデータが数値以外だったらエラー MsgBox "入力データが数値以外" Exit Sub End If Next intI Else '読み込みファイルエラー（６文字づつになっていない。） MsgBox "読み込みファイルエラー（データ長不正）" Exit Sub End If Else '読み込みファイルエラー（文字列がない） MsgBox "読み込みファイルエラー（入力なし）" End If End With '開いたファイルをクローズ Workbooks(FileName).Close '貼り付けたいシート(＝Sheet2)への処理 With ThisWorkbook.Sheets("Sheet2") '.Cells(行数,列数) For intj = 1 To intLen '１行目１列(A1セル)から１行目18列(R1セル)へデータ設定 .Cells(1, intj) = Val(strData(intj)) / 10 Next intj End With End If