複数シートのデータを１シートにまとめたい

質問

添付ファイルのシート名（A商店～C商店）のような同フォームの複数シートのデータをシート名（まとめ）にょうに１シートにまとめたいのですが、いい方法ご存知でしたらお教えください。
　パワークエリで出来そうな気もするのですが
　ちなみに実作業で使用するファイルはシート数は100くらいあり、行数も100行くらいあります。
　EXCELに長けた方、お教えください。

回答No.3

HohoPapa · ベストアンサー

VBAとSQLの組み合わせでよければ
後記のコードでいかがでしょうか。

なお、
シートの1枚目が集約先であること、
有効なレコードは、1列目が必ず埋まっていることが前提です。

Option Explicit

Sub Sample()

　Dim SQL As String
　Dim cn As Object
　Dim rs As Object
　Dim i As Long
　Dim j As Long
　Dim ShName As String
　Dim LastRow As Long

　'出力先をクリアー
　ThisWorkbook.Sheets(1).Cells.ClearContents

　'SQL環境定義、DB接続
　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1"
　cn.Open ThisWorkbook.Path & "\" & ThisWorkbook.Name

　'2枚目シートから末尾シートまで繰り返し
　For i = 2 To ThisWorkbook.Sheets.Count

　　ShName = ThisWorkbook.Sheets(i).Name

　　'SQL全文を組み立て
　　SQL = "SELECT *" & vbCrLf
　　SQL = SQL & "FROM [" & ShName & "$]" & vbCrLf

　　'SQLを実行
　　rs.Open SQL, cn

　　With ThisWorkbook.Sheets(1)
　　　'列名を出力
　　　If i = 2 Then
　　　　For j = 0 To (rs.Fields.Count - 1)
　　　　　.Cells(1, j + 1).Value = rs.Fields(j).Name
　　　　Next j
　　　End If

　　　'結果セットを出力
　　　If i = 2 Then
　　　　.Cells(2, 1).CopyFromRecordset rs
　　　Else
　　　　LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　　.Cells(LastRow, 1).CopyFromRecordset rs
　　　End If
　　End With

　　rs.Close

　Next i

　'後処理
　Set rs = Nothing
　cn.Close
　Set cn = Nothing

End Sub

お礼

うまくできました。
ありがとうございます。

回答No.6

msMike

[No.5]で提示した数式に必要な範囲名リストです。
添付図参照(Excel 2019)
￣￣￣￣￣￣￣￣￣￣￣↓↓↓↓↓↓↓↓↓↓↓↓↓

お礼

ありがとうございます。

回答No.5

msMike

Sheetまとめ において、
=OFFSET(INDIRECT("Sheet"&(1+INT((ROW(A1)-1)/7))&"!"&$A$1),MOD(ROW(A1)-1,7),COLUMN(A1)-1)
なる配列(CSE)数式を入力したセル A2 を右２列に入力後、範囲 A2:C2 のフィルハンドルを下方にドズズーッと(22行目まで)ラッグ＆ペースト

回答No.4

imogasi

VBAでも、人間の手作業でやるとすると、やりそうなやり方（思考方法）に倣う方法でできます。
コード行数もまあまあ小数です。
パワークエリなど高度なソフトでもできるでしょうし、WEBにフリーソフトもあると思います。
Excelは、表（今回は複数）の組み換えに当たる機能がないように思います。ただ統合という機能がありますが。
ーー
例データ
Sheet1
氏名 住所 買上額
山田 東京 100
近藤 大阪 200
木村 横浜 300
Sheet2
氏名 住所 買上額
大島 大阪 500
鳥居 東京 600
熊野 横浜 700
Sheet3
氏名 住所 買上額
山本 名古屋 1100
西 京都 1200
南野 東京 1300
安井 大阪 1400
ーーー
見出し行は全シート同じ（列データは同じ性格のものでないと集約は意味がない。また、１行だと、しています。）
標準モジュールに
Sub test01()
For Each sh In Worksheets
'MsgBox sh.Name
MsgBox sh.Index
'集約シートは集積処理を除外
If sh.Name = "Sheet4" Then GoTo p1
Set r = sh.Range("A1").CurrentRegion
If sh.Index = 1 Then '先頭シートは
'CurrentRegion　そのまま範囲指定
Set r2 = sh.Range("A1").CurrentRegion
r2.Copy Worksheets("Sheet4").Cells(1, 1) 'Sheet4の先頭から貼り付け
Else '先頭シート以外は
Set r = sh.Range("A1").CurrentRegion
'---CurrentRegionから見出し行の削除した範囲指定
Set r2 = r.Resize(r.Rows.Count - 1).Offset(1, 0)
'---集約シートの現最終行＋１以下に貼ろ付け
lr = Worksheets("Sheet4").Range("A100000").End(xlUp).Row + 1
r2.Copy Worksheets("Sheet4").Cells(lr, 1)
End If
p1:
Next
End Sub
と作って、実行。
結果
Sheet4
氏名 住所 買上額
山田 東京 100
近藤 大阪 200
木村 横浜 300
大島 大阪 500
鳥居 東京 600
熊野 横浜 700
山本 名古屋 1100
西 京都 1200
南野 東京 1300
安井 大阪 1400
Sheet4というシート名は、本番データでは、白紙シートを１つ作り、そのシート名に変えてください。

お礼

ありがとうございます。

回答No.2

Chiquilin

> パワークエリで出来そうな気もするのですが
できるでしょう。

[データの取得]→[ファイルから]→[ブックから]で
[複数のアイテムの選択]にチェック入れて Shift押しながら
まとめシート以外のシートを選択→クエリを接続のみで読み込み

[データの取得]→[クエリの結合]→[追加]
[3つ以上のテーブル]を選択し Shift押しながらクエリを指定
→[追加]→[OK]

以上

> ちなみに実作業で使用するファイルはシート数は100くらいあり
「Excelに長けた」人はこんな表の作り方をそもそもしません。

根本的には 表を「シート」で分ける ワープロ的な発想から頭を切
り替えないと どこかで立ち行かなくなります。

お礼

ありがとうございます。

回答No.1

aokii

新しいエクセルのシートに、添付ファイルの、ファイル名(Book1.xlsx)＋シート名(A商店～C商店等)＋セル(A1～C200等) の全リストを作って、引用のデータ式(=[Book1.xlsx]A商店!A1等)を＆等の関数で作り、複数シートのデータを引用できるようにして、１シートにまとめてみて下さい。なお、シート数が100あるのでしたら、パソコンの性能によっては、時間がかかるかもしれません。