| 
    
     |  | ▼es さん: 
 複数ファイル --> 複数シート の件了解です。
 であればアップ済みのコードでいけると思いますが、以下は
 シート転記時のループをなくしたバージョンです。
 
 Sub ファイル読み込み3()
 
 Dim myfilenames As Variant
 Dim i As Integer
 Dim temp As String
 
 Dim d As Variant
 
 myfilenames = Application.GetOpenFilename(MultiSelect:=True)
 
 If IsArray(myfilenames) = True Then
 If UBound(myfilenames) > ThisWorkbook.Worksheets.Count Then
 MsgBox "選択されたファイル数が転記用シート数を超えています"
 Else
 
 For i = 1 To UBound(myfilenames)
 
 temp = Space(FileLen(myfilenames(i)))
 
 Open myfilenames(i) For Binary As #i
 
 Get #i, , temp
 
 Close #i
 
 With ThisWorkbook.Worksheets(i)
 d = Split(temp, vbCrLf)
 .Cells.ClearContents
 .Cells(1, "A").Resize(UBound(d)).Value = _
 WorksheetFunction.Transpose(d)
 End With
 
 Next i
 
 End If
 
 End If
 
 
 End Sub
 
 
 |  |