まず、問題
作業では、複数の小さなExcelファイルを1つのExcelファイルにマージする必要があります。ファイル形式とコンテンツは一貫しています。ファイルが多数あるため、手動での貼り付けとコピーは考慮せず、VBAプログラムを使用してこの問題を解決することを直接検討してください。
図1同じフォルダー内の複数のExcelファイル
第二に、コード
サブフォルダ内のすべてのファイルを開き、指定されたコンテンツをコピーします（）
Dim a $、n As Long、i As Long、Num As Long、Name $ 'nを書き込みの開始行番号として定義し、Numをファイル数として定義します。nは長整数として設定するのが最適です。そうでない場合、Dim h をオーバーフローするのは簡単です％ 'hは、最初の行（フィールド名）を除くコンテンツ行の数として定義されます
Dim mypath $
t = Timer
Application.ScreenUpdating = False
mypath = ActiveWorkbook.Path '現在のマクロファイルが配置され
ている照会 フォルダーパスを取得します a = Dir（mypath＆ "\ "＆" * .xls "） '現在のフォルダ
Workbooks.Open mypath のファイルパスを取得＆" \ "＆a'ファイル
Workbooksをトラバース （a）.Activate
i = Sheets（" Sheet0 "）。Range（" a65536 "） .End（xlUp）.Row ' Here。xls の最大行数は65536
ブック（a）.Sheets（ "Sheet0"）のみです。範囲（ "A2"、 "P"＆i）.Copy Workbooks（ "Summary"） .Sheets（ "Summary"）。範囲（ "A2" ）
Workbooks（ "汇总"）.Sheets（ "汇总"）.Range（ "Q2"、 "Q"＆i）= a
Workbooks（a）.Close
Num = 1
Name = Left（a、Len（a）-4）
Do
a = Dir
If a <> "" And a <> "汇总.xlsm" Then
Workbooks.Open mypath＆ "\"＆a
n = Workbooks（ "汇总" ）.Sheets（ "汇总"）.Range（ "a1048576"）。End（xlUp）.Row + 1
Workbooks（a）.Activate
i = Workbooks（a）.Sheets（ "Sheet0"）。Range（ "a65536"） .End（xlUp）.Row
Workbooks（a）.Sheets（ "Sheet0"）。Range（ "A2"、 "P"＆i）.Copy Workbooks（ "汇总"）.Sheets（ "汇总"）.Range（ " A "＆n）
Workbooks（"汇总 "）.Sheets（"汇总 "）.Range（" Q "＆n、" Q "＆n + i-2）= a
Workbooks（a）。 閉じる
Num = Num + 1
Name = Name＆Left（a、Len（a）-4）
'MsgBox "Together："＆Num＆ "Files！"
Else
MsgBox "Together："＆Num＆ "Files！ "＆"共有時： "＆（Timer-t）＆" s "
ループ 終了サブの
場合、 サブ 終了を終了
