複数シートから指定した範囲を別シートにコピーしたい

質問

＜状況＞
エクセル2016を使用しています。
・同じ書式のファイルが100個ほどフォルダにあります。
・すべてのファイルはシート1しかありません。
・セルA8：P27までの範囲をひとつのシートにコピーさせたいと思います。

VBでもマクロでも構いませんのでご教授ください。

回答No.3

SI299792

すみません、間違いがありました。ついでに罫線を直す機能を付けました。
後、注意事項を付け忘れました
出力ワークブック（マクロを入れるワークブック）にタイトル行（注文番号…）が必要です。
'
Option Explicit
'
Sub Macro1()
'
　　Dim FileName As String
　　Dim OY As Long
'
　　ChDrive ThisWorkbook.Path
　　ChDir ThisWorkbook.Path
　　FileName = Dir("*.xls*")
　　'OY = 8 '空白を詰める場合不要
'
　　Do While FileName > ""
'
　　　　If FileName <> ThisWorkbook.Name Then
　　　　　　OY = Cells(Rows.Count, "B").End(xlUp).Row + 1 '空白を詰めない場合不要
　　　　　　Workbooks.Open FileName
　　　　　　[A8:P27].Copy ThisWorkbook.ActiveSheet.Cells(OY, "A")
　　　　　　ActiveWindow.Close
　　　　　　Range("A" & OY & ":P" & OY).Borders(xlEdgeTop).LineStyle = xlDouble
　　　　　　'OY = OY + 20 '空白を詰める場合不要
　　　　End If
　　　　DoEvents
　　　　FileName = Dir
　　Loop
'　 最終行の削除、空白を詰めない場合この先不要
　　OY = Cells(Rows.Count, "B").End(xlUp).Row + 1
　　Rows(OY & ":" & OY + 20).Delete
　　Range("A" & OY & ":P" & OY).Borders(xlEdgeTop).Weight = xlMedium
End Sub

後、捕捉に、
「1シート目のA8:P27がマクロのあるシートのB2:Q22に貼り付け」
と書いてありますが、図を見ると、A8:P27に貼り付けてあります。
図を信じてにして、Ａに張り付けるようにしました。Ｂに張り付けるなら、
　　　　　[A8:P27].Copy ThisWorkbook.ActiveSheet.Cells(OY, "B")
にして下さい。

回答No.2

SI299792

こんなところですね。
保存されたフォルダを参照しているので、このマクロを入れたワークブックを実行したいフォルダに保存してから実行して下さい。
下の空白を詰めるかどうか書いてなかったので、詰めるとしました。ここはきちんと書いて下さい。詰めなくでいいなら、コメントを見て直してください。
不自然の思ったのですが、店名はいらないのですが？
'
Sub Macro1()
'
　　Dim FileName As String
　　Dim OY As Long
'
　　ChDrive ThisWorkbook.Path
　　ChDir ThisWorkbook.Path
　　FileName = Dir("*.xls*")
　　'OY = 8 '空白を詰める場合不要
'
　　Do While FileName > ""
'
　　　　If FileName <> ThisWorkbook.Name Then
　　　　　　OY = Cells(Rows.Count, "A").End(xlUp).Row + 1 '空白を詰めない場合不要
　　　　　　Workbooks.Open FileName
　　　　　　[A8:P27].Copy ThisWorkbook.ActiveSheet.Cells(OY, "B")
　　　　　　'OY = OY + 20 '空白を詰める場合不要
　　　　　　ActiveWindow.Close
　　　　End If
　　　　DoEvents
　　　　FileName = Dir
　　Loop
End Sub

補足

SI299792 さん
コード記載いただきありがとうございます。

教えていただいたコードを実行しましたが、
3シートで実行したところ
1シート目のA8:P27がマクロのあるシートのB2:Q22に貼り付け
2シート目のA8:P27がマクロのあるシートのB2:Q22に貼り付け
3シート目のA8:P27がマクロのあるシートのB2:Q22に貼り付け

となり、シート3の情報だけ残ります。
ステップインで確認すると確かに1シート目を張り付けて、
同じシートの同じセルにシート2の情報を上書きし、
その上にシート3のデータも上書きしています。

本来は
1シート目のA8:P27がマクロのあるシートのB2:Q22に貼り付け
2シート目のA8:P27がマクロのあるシートのB23:Q43に貼り付け
3シート目のA8:P27がマクロのあるシートのB44:Q64に貼り付け
たいと考えています。

上記が出来たら、空白のセルも詰めたいと考えています。

回答No.1

imogasi

下記を認識して勉強し、親切な人の回答を待って下さい。
>同じ書式のファイルが
エクセルで「書式」とは表示形式などのことで、操作でホームー書式を選択して、それ以下の操作で詳細の設定できるものです。
エクセルの術語です（エクセルの質問では、それ以外の使い方は適当でない）。
質問者の言う書式とは、列見出しで意味するデータ項目の「有無＋並び順」が対象シートで、同じということでしょう。
言い換えると、集約シートの最終行の次から張り付けても、良い（表として意味がある）ということでしょう。
＞すべてのファイルはシート1しかありません。
各ブックのＳｈｅｅｔｓ（１）でとらえられる、シートだけ問題にすればよい（コピー貼り付けは打ち切ってよい）ということでしょう。
複数シートがあるより、相当簡単になる。
＞・セルA8：P27までの範囲をひとつのシートにコピーさせたいと思います。
全ブックの第1シートのセルA8：P27をコピーして集約シートに貼りつければよいということ。
＞VBでもマクロでも構いませんのでご
近時のＶＢとＶＢＡは違うものです。本件はＶＢＡのことをｐ言っているのでは。ＶＢ（・ＮＥＴ系）でもエクセルは操れるが、質問者は、そのレベルではないでしょう。
それで、ＶＢＡもマクロも同じものを指しているはず。
ーー
集約シートの途中での状態の最終行は
Ｅｎｄ（ｘｌｕｐ）．Ｒｏｗ
でとらえられるので、行的に＋１下行のＡ列を左上隅にしたセル範囲に張り付ければよい。
ーー
本件は、丸投げで、コードを書けという無いようだ。
下記をＧｏｏｇｌｅでも照会して勉強して、親切な人の、回答を待て。
課題スキル
（１）１フォルダ内のファイル（=ブック）をとらえる方法（ＶＢＡのコード）
検索語「ＶＢＡ　フォルダー　ファイル　捉える」
http://h1r0-style.net/excelvba/howto-get-list-of-files-in-the-folder　など
（２）シートの最終行をとらえる方法
検索語「ＶＢＡ　シートの最終行を取得」
http://excel-ubara.com/excelvba1/EXCELVBA318.html
（３）コピー貼り付けの方法