前提・実現したいこと
同一フォルダ内にある複数のファイル(同フォーマット)を1つのファイルにまとめたく、各ファイルの内容とファイル名(もしくはFullnameパス)を同一のシートにコピーして貼り付けたい。
各ファイルの中身は項目が同一なので列数は同じ、件数が違うため行数はまちまちです。
ファイルの中身をコピーして貼り付けるマクロはなんとかできたのですが、ファイル名を取得して貼り付けるマクロがうまくいきません。
取り出した中身が10行だとすると10行分ファイル名をH列に貼付け
その下に次のファイルの中身3行があればH列に3行分ファイル名を貼付け
のようになるのが理想です。
発生している問題・エラーメッセージ
Workbook_pathで取得しようとしてもそもそも何も起きない。
該当のソースコード
Sub matome() Dim buf As String, i As Long Dim Workbook_path As String Dim j buf = Dir(Sheets("Sheet1").Range("A2").Value & "*.xls") Do While buf <> "" Workbooks.Open Worksheets("Sheet1").Range("A2").Value & "\" & buf Sheets("貼付け元").Range("B4:H100").Copy ThisWorkbook.Activate Range("A65536").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Workbooks(buf).Activate Application.CutCopyMode = False Workbooks(buf).Close SaveChanges:=False buf = Dir() Workbook_path = ActiveWorkbook.FullName ThisWorkbook.Activate Range("H65536").End(xlUp).Offset(1, 0).Select Loop End Sub
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/05/08 06:02
2018/05/08 06:21
2018/05/08 06:27
2018/05/08 06:33
2018/05/08 06:47 編集
2018/05/08 07:19
2018/05/08 08:10
2018/05/08 08:14