質問: Application.GetOpenFilename("テキストデータ,*.txt", MultiSelect:=True) If IsArray(OpenFileNames) Then For Each f In OpenFileNames すみませんが御教授頂よろしくお願いします。
回答: こんにちはこんばんは、よろしくおねがいいたします。 まず、”テキストデータ”と書いておられますが、”手作業”のところを読むとどうやらエクセルファイルのようなので、そのように理解しました。 で、こういうのはどうでしょうか? ``` Option Explicit Sub test() Dim FileNameList As Variant Dim i As Long Dim SourceFileName As String Dim TenkiMotoBook As Workbook Dim TenkiMotoFileName As String Dim TenkiMotoSheet As Worksheet Dim TenkisakiSheet As Worksheet Dim TenkiMotoRange As Range Set TenkisakiSheet = ThisWorkbook.Worksheets("sheet1") Dim r As Long, c As Long r = 10 : c = 7 'G10セルのことです FileNameList = Application.GetOpenFilename("Microsote Excelブック, *.xlsx", MultiSelect:=True) If Not IsArray(FileNameList) Then 'キャンセルボタンが押されたとき、終了する Exit Sub End If For i = 1 To UBound(FileNameList) 'ダイアログで選択した数だけループする SourceFileName = FileNameList(i) Workbooks.Open SourceFileName 'ファイルを開く Set TenkiMotoBook = ActiveWorkbook Set TenkiMotoSheet = ActiveWorkbook.Worksheets("sheet1") TenkiMotoFileName = Dir(SourceFileName) 'フルパスのファイル名から、ファイル名だけを抽出する '転記元のファイル名を、10行目の部分にセットする TenkisakiSheet.Cells(r, c) = TenkiMotoFileName TenkiMotoSheet.Select 'F2セルから下へ、データのある範囲をコピーし、転記先シートへペーストする TenkiMotoSheet.Range("F2", Range("F2").End(xlDown)).Copy TenkisakiSheet.Cells(r + 1, c) '転記元のブックを閉じる TenkiMotoBook.Close c = c + 1 '右の列へシフトする Next i End Sub ``` 当方でテストしてみました。これで動作します。お試しください。