EXCEL マクロで 同じフォルダ内の複数ファイルの複数行全体を選択して１つのファイルに集約

よろしくお願いします。
同じ質問を以前したのですが、日にちが経って締め切りになってしまい
未だに自分では解決できないため、お知恵を借りたく、再度質問させて頂くものとなります。
過去、ご回答頂いた方、ありがとうございました。
再度の質問、ご容赦ください。

アンケートのExcelシートを配布し、【記入表】というシートの4-6行目に記入してもらい1つのシートに集約したいと思っています。（画像をご参照ください）

対象者は500近くで有り、500近くのExcelファイルを1つのフォルダに格納、
別ブックの【回答一覧】というシートに集約したいと思っています。

今までは4-6行目（行全体）を選択し、コピーして【回答一覧】シートに貼り付けをしていました。

同じことの繰り返しなので、マクロで何とか出来ないかと思っています。

下記の画像でコピーしたい【記入表】シートの
表頭の3行目を除いた4-6行目（行全体はどのようにしていすればよいのでしょうか。セルの範囲指定はresizedを使うことは調べました）

を値貼り付けで（関数やリスト入力の値が入っている場合があります）

別ブックの【回答一覧】シート

に集約したいのです。

マクロで出来るのでしょうか。

回答の3行ずつが、【回答一覧】シートに値貼付けされていくイメージです。
この際、Aさんという回答部分にBさんの回答が上書きされないようにしたいです。

【回答一覧】シートに

Aさんの【記入表】4-6行目が【回答一覧】の4-6行目
Bさんの【記入表】4-6行目が【回答一覧】の7-9行目
Cさんの【記入表】4-6行目が【回答一覧】の10-12行目

という感じに集約していきたいのです。

各人から回答を記入したシートを同じフォルダ内に集約しておけば
可能でしょうか。

回答頂いたファイルを同じフォルダに保存していき、回答一覧シートに上書きしていくことを想定しています。
（１０月１日にはA、B、Cからの回答ファイルを集約、１０月８日にはD、Eから回答があった場合、８日にはA、B、C、D、Eの過去の回答も含め全てマクロで集約することを想定しています。）

お知恵を貸してください。

よろしくお願いします。

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/09/28 09:31

以下のマクロを標準モジュールに登録してください。

Const Folder As String = "D:\goo\data8" 'excelファイル格納フォルダ
は、「500近くのExcelファイルを1つのフォルダに格納」してあるフォルダ名です。あなたの環境にあわせて適切に設定してください。



Option Explicit

Public Sub アンケート集計()
Const Folder As String = "D:\goo\data8" 'excelファイル格納フォルダ
Dim fname As String 'ファイル名
Dim wb2 As Workbook '記入表のブック
Dim WS1 As Worksheet '回答一覧
Dim wS2 As Worksheet '記入表
Dim row1 As Long '回答一覧の処理行
Set WS1 = Worksheets("回答一覧")
'4行以降をクリア
WS1.Rows("4:" & Rows.Count).ClearContents
row1 = 4 '4行から書き込み
fname = Dir(Folder & "\*.xlsx") '指定フォルダ内の*.xlsxを取得
If fname = "" Then
MsgBox (Folder & "内に.xlsxなし")
Exit Sub
End If
Do While fname <> ""
'該当ファイルをオープン
Set wb2 = Workbooks.Open(Folder & "\" & fname)
Set wS2 = wb2.Worksheets("記入表")
'記入表から回答一覧へ３行分まとめて転記
WS1.Rows(row1 & ":" & row1 + 2).Value = wS2.Rows("4:6").Value
wb2.Close SaveChanges:=False
'回答一覧の処理行に3加算
row1 = row1 + 3
'次のexcelファイルを取得
fname = Dir()
Loop
MsgBox ("処理完了")
End Sub

この回答へのお礼

回答ありがとうございます。

大変助かりました。
やりたいことが実現出来ました。

お礼日時：2022/10/10 13:46

No.4 回答者： banzaiA 回答日時： 2022/10/03 17:14

パワークエリが得意の範疇でもありそうですね。

この回答へのお礼

回答ありがとうございます。

パワークエリというのが有るのですね。

少しづつ勉強したいと思います。

お礼日時：2022/10/03 18:25

No.2 回答者： fujillin 回答日時： 2022/09/28 08:54

こんにちは

＞マクロで出来るのでしょうか。
ご質問文に記載のない、後出しの特殊条件等が無ければ可能でしょう。

＞表頭の3行目を除いた4-6行目（行全体はどのようにしていすれば
＞よいのでしょうか。セルの範囲指定はresizedを使うことは調べました）
固定範囲なので、対象シートの
　.Rows("4:6")
で、4～6行目の行全体の範囲を指定できます。

＞を値貼り付けで（関数やリスト入力の値が入っている場合があります）
Copy して、PasteSpecial(xlPasteValues) でも可能ですが、
　DestinationRange.Value = SourceRange.Valjue
とすることで、直接「値を転記」できます。
ただし、この場合はそれぞれのRangeのサイズを同じにしておく必要があります。

＞という感じに集約していきたいのです。
転記先を変数にしておいて（DestinationRange）、初期値をセットしたら、後はループ内で転記する毎に
　Set DetsinationRange = DestinationRange.Offset(3)
とすることで、3行分下にずれますので、次の転記先を示すことが可能です。


以前にも回答しましたが、同様のご質問を何度もなさっているようですが、基本的なループ等は既に作成してもらっているはずですので、そちらを利用なさればよいでしょう。
https://oshiete.goo.ne.jp/qa/13132300.html

この回答へのお礼

回答ありがとうございます。
大変助かりました。

お礼日時：2022/10/10 13:44

No.1 回答者： banzaiA 回答日時： 2022/09/28 08:28

>同じことの繰り返しなので、マクロで何とか出来ないかと思っています。

マクロで何とかできるだろうと思いますよ。
で、質問者さんはある程度のマクロ経験者ですよね？

この回答へのお礼

回答ありがとうございます。
マクロの経験者ではありません。
全くの初心者です。

お礼日時：2022/10/03 08:30