| |
以下内容でご教授いただきたく質問させていただきます。
行いたい事
転記先シートB3（開いているブック）に入力されている文字が保存名にあるxlsmファイルを検索して開く。
一致するファイルがある場合セルA18〜E38の間のデータが入力されている部分のみをコピーし転記先シートのA18〜E38セルへコピー。
転記元ファイル数、転記データの行数が異なる為、転記時に転記先シートのデータがないセルにコピーを行う。
一致するファイルがなくなるまで以上の処理を繰り返す。
ファイルの検索方法、データの貼り付け位置指定の手段が思いつかない為質問させていただきました。
仕様に関してアドバイスの程、よろしくお願いいたします。
Sub データ収集()
Dim FolderPath As String, Filename As String, ws As Worksheet
' 転記元ファイルがあるフォルダのパスを指定
FolderPath = ("転記元フォルダ")
' 拡張子が.xlsmのファイルを検索
Filename = Dir(FolderPath & "*.xlsm")
While Filename <> ""
Workbooks.Open FolderPath & Filename ' 転記元ファイルを開く
For Each ws In ActiveWorkbook.Sheets(1) ' 転記元のシートを指定
ws.UsedRange.Copy ThisWorkbook.Sheets(DB).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) ' 転記先のシートを指定
Next ws
Workbooks(Filename).Close SaveChanges:=False
Filename = Dir
Wend
'コピー指定解除
Application.CutCopyMode = False
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
