Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

95 / 76807

←次へ　｜　前へ→


	【82383】複数のエクセルブックからデータを取得してひとつのブックにしたい

ぺろ - 24/10/9(水) 10:25 -


	引用なし

	パスワード

以下内容でご教授いただきたく質問させていただきます。

行いたい事
転記先シート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

3 hits

▼

【82383】複数のエクセルブックからデータを取得してひとつのブックにしたい ぺろ 24/10/9(水) 10:25