Excel VBA で同フォルダにあるBookの同名シートを一つのシートにまとめる

公開日: : VBA

同じブックにまとめるやりかたと同じシートにまとめるやりかたを書いてます。

元々のソースはこのページ最下部にリンクを張っておきましたのでそちらをご参照ください。VBA初心者のアタクシが細かいところでひっかかったので、自分にわかりやすいようにメモしたものなので。

同じブックの同じシートに全てまとめる場合

条件:

  • 同じフォルダに基Excelファイルを配置する
  • 基Excelファイルは閉じてる状態


Sub Test()
myPath = ThisWorkbook.Path & "\"
fname = Dir(myPath & "*.xlsx") 'フォルダ内のExcelファイルを検索します

Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行します
If fname <> ThisWorkbook.Name Then
Workbooks.Open myPath & fname '選択したファイルを開きます
Set AB = ActiveWorkbook
lr = ThisWorkbook.Sheets("sheet1").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

On Error Resume Next
AB.Sheets("★コピーしたいシート名").UsedRange.Copy
On Error GoTo 0
ThisWorkbook.Activate
Sheets("Sheet1").Range("A" & lr + 2).Select
ActiveSheet.Paste

'クリップボードに大きな情報がありますを表示させない対応
ActiveSheet.Range("A1").Copy

'Bookを閉じる
AB.Close
End If
fname = Dir '選択したフォルダ内の次のExcelファイルを検索します
Loop
End Sub

同じブックの同じシートに全てまとめる場合-値のみ貼り付ける

正式には、「値の貼り付け」を行いたい場合。
貼り付け元のデータがどこかのデータを参照(リンク)している場合、参照先がズレる場合があった。これでやるとリンク情報や書式はコピーされない。数値が見たままコピーされる。


Sub Test()
        myPath = ThisWorkbook.Path & "\"
        fname = Dir(myPath & "*.xlsx") 'フォルダ内のExcelファイルを検索します

        Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行します
                If fname <> ThisWorkbook.Name Then
                        Workbooks.Open myPath & fname '選択したファイルを開きます
                        Set AB = ActiveWorkbook
                        lr = ThisWorkbook.Sheets("sheet1").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row


                        On Error Resume Next
                        AB.Sheets("★コピーしたいシート名").UsedRange.Copy
                        On Error GoTo 0
                        ThisWorkbook.Activate
                        'Sheets("Sheet1").Range("A" & lr + 2).Select
                        'ActiveSheet.Paste
                        Sheets("Sheet1").Range("A" & lr + 2).PasteSpecial (xlPasteValues)
                        

                        'クリップボードに大きな情報がありますを表示させない対応
                        ActiveSheet.Range("A1").Copy

                        'Bookを閉じる
                        AB.Close
                End If
                fname = Dir '選択したフォルダ内の次のExcelファイルを検索します
        Loop
End Sub


同じブックでシートは別々にしてまとめる場合

条件:

  • 同じフォルダに基Excelファイルを配置する
  • 基Excelファイルは閉じてる状態
Sub Sample()

'ここでシート名を指定して実行してね!
Const sheet_name As String = "★コピーしたいシート名"

Dim month_n As Integer
month_n = 3

Dim sFile As String
Dim sWB As Workbook, dWB As Workbook
Dim dSheetCount As Long
Dim i As Long
Const SOURCE_DIR As String = "D:\Documents\基になるエクセルファイル達が居るフォルダ\"
Const DEST_FILE As String = "D:\Documents\1つにまとめた結果ファイルを置くフォルダ\" & sheet_name & ".xlsx"

Application.ScreenUpdating = False

'指定したフォルダ内にあるブックのファイル名を取得
sFile = Dir(SOURCE_DIR & "*.xlsx")

'フォルダ内にブックがなければ終了
If sFile = "" Then Exit Sub

'集約用ブックを作成
Set dWB = Workbooks.Add

'集約用ブック作成時のシート数を取得
dSheetCount = dWB.Worksheets.Count

Do
'コピー元のブックを開く
Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)

'コピー元の「報告書」シートを集約用ブックにコピー
sWB.Worksheets(sheet_name).Copy After:=dWB.Worksheets(dSheetCount)

'シート名をセルA1の値に変更
'ActiveSheet.Name = Range("A1").Value
ActiveSheet.Name = month_n

month_n = month_n - 1

If month_n <= 0 Then
month_n = 12
End If

'コピー元ファイルを閉じる
sWB.Close

'次のブックのファイル名を取得
sFile = Dir()
Loop While sFile <> ""

'集約用ブック作成時にあったシートを削除
Application.DisplayAlerts = False
For i = dSheetCount To 1 Step -1
dWB.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

'集約用ブックを保存して閉じる
dWB.SaveAs Filename:=DEST_FILE
dWB.Close

Application.ScreenUpdating = False

MsgBox ("complete.")
End Sub

参考にしたサイト

https://oshiete.goo.ne.jp/qa/1780042.html

http://www.moug.net/tech/exvba/0060003.html

ほぼ丸パクリです。

ありがとうございましたm(__)m

Googleアドセンスレスポンシブ

関連記事

no image

Excelでフッターを一括設定!ページレイアウトも崩れないやり方

同じブック内ですべてのシートが同じページレイアウトだったら、 すべてのシートをSHIF

記事を読む

Googleアドセンスレスポンシブ

Message

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください

Googleアドセンスレスポンシブ

php-logo
php =& イコールアンパサンド で参照渡し

意味 変数やオブジェクトなどを参照渡しする。 # 下記はど

php-logo
php5 varによる宣言

古い、人が作ったソース見てたらvarで変数宣言しているのがあって調

php-logo
php parent 親クラスのプロパティやメソッドにアクセスする

子クラスで使う すると親クラスのプロパティやメソッドにア

php-logo
phpの変数などにつく「_」アンダースコアについて調べた

ちょこちょこいろんなところで見てモヤモヤしておりました。phpだけ

数字と記号
Webブラウザだけでfavicon.ico作成

  1.基となる記号作成 こちら  

→もっと見る

PAGE TOP ↑