[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数ブックの同一名シートを1つのブックにコピーする』(TK)
いつもお世話になっております。
今、各施設から集められたデータを整理したいと考えています。状況としては以下のとおりです。
・各施設が規定のエクセルフォーマットに入力し、データを送付してくる
・フォーマットには5つのシートがある(シート名は左から1,2,3,4,5)
・ファイル名は各施設の名前をつけている
(施設の名前がついた複数のファイルがあり、シート名は複数のファイル全てで同じもの(1,2,3,4,5)が使用されている、という状態です)
やりたいこと
・新規ブックを作成(新規ブックの名前は、例えば1(元のシート名のどれか))。その新規ブックに、新規ブック名と同じシート(例えば1)をそれぞれのファイルの中から取り出し、シート自体をコピーしたい
・シート自体をコピーする際に、シート名を元のファイル名に変えたい
(出来上がりとしては、最初のシート名(例えば1)が出来上がりのファイルの名前になり、その出来上がったファイルの中に、最初のぞれぞれのファイル名がついたシートが集められている、という感じをイメージしてます)
いろいろと試してみたのですがどうしてもうまくいかず、お聞きする次第です。もし何か情報の不足がありましたらお教えください。どうかよろしくお願いいたします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
これを少し変えてfor文で5回回せばできます。
(デイト) 2015/05/22(金) 15:05
Dim sFile As String Dim sWB As Workbook, dWB As Workbook Dim dSheetCount As Long Dim i As Long Dim c As Long Const SOURCE_DIR As String = "C:\Users\date\Desktop\新しいフォルダー\a\"
Application.ScreenUpdating = False
'指定したフォルダ内にあるブックのファイル名を取得 For c = 1 To 5 sFile = Dir(SOURCE_DIR & "*.xls*")
'フォルダ内にブックがなければ終了 If sFile = "" Then Exit Sub
'集約用ブックを作成 Set dWB = Workbooks.Add
'集約用ブック作成時のシート数を取得 dSheetCount = dWB.Worksheets.Count
Do 'コピー元のブックを開く Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)
'コピー元の c (1,2,3,4,5)シートを集約用ブックにコピー sWB.Worksheets(c).Copy After:=dWB.Worksheets(dSheetCount) 'シート名をファイル名に ActiveSheet.Name = sFile
'コピー元ファイルを閉じる 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:="C:\Users\date\Desktop\新しいフォルダー\" & c & ".xlsx" dWB.Close Next Application.ScreenUpdating = False End Sub
保存先や取り出しブック先は変更してください
(デイト) 2015/05/22(金) 16:53
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.