Excel2013 複数ファイルシート別結合

質問

複数のエクセルファイルがありシート名A、B、C、D、Eとあります。
B8からG8まで題名がありB９からデータが入ってます。
B9からのデータ行数は毎回違います。それを同じシート名ごとに貼り付けたいです。
エクセル１エクセル2エクセル3
全シート名があるエクセル１のデータの下に貼り付けていきたいです。エクセル2とエクセル3を

ファイルごとにあるシートは変わります。ないシートがあったりします。
それをマクロでやりたいです。よろしくお願いします。

回答No.3

SI299792 · ベストアンサー

使い方。
ワークブックを１つ作って、このマクロをコピぺ
結合したいフォルダに保存してから実行してください。
（フォルダ名とファイル名を確定するために、実行前に保存する必要があります。）
'
Option Explicit
'
Sub Macro1()
'
　　Dim FileName As String
'
　　ChDrive ThisWorkbook.Path
　　ChDir ThisWorkbook.Path
　　FileName = Dir("*.xls*")
'
　　Do While FileName > ""
'
　　　　If FileName <> ThisWorkbook.Name Then
　　　　　　Convate FileName
　　　　End If
　　　　FileName = Dir
　　Loop
End Sub
'
Sub Convate(FileName As String)
'
　　Dim Book As Workbook
　　Dim Sheet As Worksheet
　　Dim SheetName As String
　　Dim MaxRow As Long
　　Dim MaxCol As Integer
'
　　Set Book = Workbooks.Open(FileName)
'
　　For Each Sheet In Worksheets
　　　　Book.Activate
　　　　Sheet.Select
　　　　SheetName = Sheet.Name
　　　　With ActiveSheet.UsedRange
　　　　　　MaxRow = .Rows(.Rows.Count).Row
　　　　　　MaxCol = .Columns(.Columns.Count).Column
　　　　End With
　　　　[A1].Resize(MaxRow, MaxCol).Copy
　　　　ThisWorkbook.Activate
　　　　On Error GoTo 100
　　　　Sheets(SheetName).Select
　　　　On Error GoTo 0
　　　　MaxRow = [A1].SpecialCells(xlLastCell).Row
'
　　　　If MaxRow > 1 Then
　　　　　　MaxRow = MaxRow + 2
　　　　End If
　　　　Cells(MaxRow, "A").Select
　　　　ActiveSheet.Paste
　　Next Sheet
　　Application.DisplayAlerts = False
　　Book.Close
　　Application.DisplayAlerts = True
　　Exit Sub
'
100 '
　　If Err = 9 Then
　　　　Sheets.Add after:=ActiveSheet
　　　　ActiveSheet.Name = SheetName
　　　　Resume
　　End If
　　Error Err
End Sub

お礼

ありがとうございました。

回答No.2

imogasi

画像ファイルがぼやけてよく見えない。
ーー
>複数のエクセルファイルがあり
同一フォルダ内にあるのか、別フォルダにあるのか、書いてないということは、
質問者は、この質問を質問するレベルではないと思われる。丸投げの回答コードの丸写しをせざるを得ない状況だろう。
この質問は何回もここに出ている。
ーー
Vbscript（というスクリプト言語）を勉強しＦｏｒＥａｃｈでファイル名（ブック名）を１つずつ捉え、そのブック名でエクセルブックをＯｐｅｎして、そのブックのシート名もＦｏｒＥａｃｈで１つづつ捉えて、Ａｃｔｉｖａｔｅして、そこでコピーして、１つの決めたブックの決めたシート（集約する受け皿シート）に、上から張り付けていく。
前回までに張り付けたデータの最終行は、ＶＢＡでよく使われるEnd(xlUp)でとらえられるから、その次行を起点にしの下部に張り付ける。
Sub test02()
lr = Range("A100000").End(xlUp).Row
MsgBox lr
End Sub
この既作成シートごとに繰り返す。
ーー
ブックの捉え方
Ｇｏｏｇｌｅで「フォルダ ファイル名 一覧 エクセルで照会すること
（１）Ｄｉｒ法
（２）ＶＢｓｃｒiｐｔでＦｏｒ　Ｅａｃｈ法
がある。
Googleで「vba フォルダ　ファイル　エクセル　一覧」で照会
その中にたとえば（２）の方法で
Sub Sample3()
Dim f As Object, cnt As Long
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder("C:\Sample").Files
cnt = cnt + 1
Cells(cnt, 1) = f.Name
Cells(cnt, 2) = f.DateCreated
Next f
End With
End Sub
ーーーー
Ｅｘｃｅｌブックに限定方法を勉強（拡張子で）のこと
ーーーーー
シートの捉え方
Sub test01()
Dim sh
For Each sh In Sheets
MsgBox sh.Name　’－－確認用
Next
End Sub
ーー
集約したとき、余分な項目、行、空白行があるときはVBAで省けるか勉強が必要。
元データの状況によっては、VBAコード作成に手数がかかる、とかうまくロジックが組めない場合がある。そういう問題点を注目できてないのは、まだエクセルやそのVBAはじめたばかりだろうと察せらる。
ーー
集約ブックやシートはForEachの繰り返しの中で対象にならないようにスキップする必要がある。

お礼

ありがとうございました。

回答No.1

tsubu-yuki

> それをマクロでやりたいです。よろしくお願いします。
これは「作ってください」ってことですか？

きっと私の勘違い。
「手順を教えて」だと思うので、以下どうぞ。

・「エクセル１」を開いておく
・繰り返し処理１
　フォルダを指定し、フォルダ内の「エクセル１」以外について
　・開く
　・繰り返し処理２
　　ブック内の各シートについて
　　・シート名を照合
　　・必要な範囲をコピー
　　・エクセル１の同じ名前のシートの（行方向）末尾に貼り付け
　　※エクセル１に同名のシートが無かったらシート追加（？）
　　・閉じる
　・繰り返し２終了
・繰り返し１終了

がんばって作成くださいませ。

どうでもいい話ですが・・
添付されている画像、全く読めません。
辛うじて読める範囲での感想ですが、
「どうして“日別”でシートを組んじゃったかな。」
と心底思います。

お礼

ありがとうございました。