こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

投稿日時 - 2017-05-19 17:28:13

QNo.9331132

すぐに回答ほしいです

質問者が選んだベストアンサー

使い方。
ワークブックを1つ作って、このマクロをコピぺ
結合したいフォルダに保存してから実行してください。
(フォルダ名とファイル名を確定するために、実行前に保存する必要があります。)
'
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

投稿日時 - 2017-05-21 01:42:50

お礼

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

投稿日時 - 2017-05-22 10:45:51

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

画像ファイルがぼやけてよく見えない。
ーー
>複数のエクセルファイルがあり
同一フォルダ内にあるのか、別フォルダにあるのか、書いてないということは、
質問者は、この質問を質問するレベルではないと思われる。丸投げの回答コードの丸写しをせざるを得ない状況だろう。
この質問は何回もここに出ている。
ーー
Vbscript(というスクリプト言語)を勉強しForEachでファイル名(ブック名)を1つずつ捉え、そのブック名でエクセルブックをOpenして、そのブックのシート名もForEachで1つづつ捉えて、Activateして、そこでコピーして、1つの決めたブックの決めたシート(集約する受け皿シート)に、上から張り付けていく。
前回までに張り付けたデータの最終行は、VBAでよく使われるEnd(xlUp)でとらえられるから、その次行を起点にしの下部に張り付ける。
Sub test02()
lr = Range("A100000").End(xlUp).Row
MsgBox lr
End Sub
この既作成シートごとに繰り返す。
ーー
ブックの捉え方
Googleで「フォルダ ファイル名 一覧 エクセルで照会すること
(1)Dir法
(2)VBscriptでFor Each法
がある。
Googleで「vba フォルダ ファイル エクセル 一覧」で照会
その中にたとえば(2)の方法で
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
ーーーー
Excelブックに限定方法を勉強(拡張子で)のこと
ーーーーー
シートの捉え方
Sub test01()
Dim sh
For Each sh In Sheets
MsgBox sh.Name ’--確認用
Next
End Sub
ーー
集約したとき、余分な項目、行、空白行があるときはVBAで省けるか勉強が必要。
元データの状況によっては、VBAコード作成に手数がかかる、とかうまくロジックが組めない場合がある。そういう問題点を注目できてないのは、まだエクセルやそのVBAはじめたばかりだろうと察せらる。
ーー
集約ブックやシートはForEachの繰り返しの中で対象にならないようにスキップする必要がある。

投稿日時 - 2017-05-19 20:41:42

お礼

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

投稿日時 - 2017-05-22 10:43:17

ANo.1

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

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

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

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


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

投稿日時 - 2017-05-19 18:13:01

お礼

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

投稿日時 - 2017-05-22 10:42:31