VBAでおしえてください

質問

お世話になっております。
今、５個のエクセルファイルがあり、それぞれ複数のシートで構成されていますが、シート名、並び順は、５個のファイルとも共通です。
シート名は、sheet1から、A,B,C,D,・・・・と割り振っております。
ここで、同じシート名のdataを同じシート内に集めたいです。。
(元DATAの形式）
ファイル１
SheetA SheetB
セル DATA セル DATA
B2 2 B2 8
B3 3 B3 5
B4 4 B4 6
ファイル2
SheetA SheetB
セル DATA セル DATA
B2 6 B2 2
B3 5 B3 3
B4 1 B4 4

VBA変換後
ファイル1
SheetA
セル DATA セル DATA
B2 2 C2 6
B3 3 C3 5
B4 4 C4 1

よろしくお願いいたします

回答No.9

hofuhofu

VBAでは無くて、VBSですが。
以下のソースをメモ帳などに貼り付けて拡張子をvbsとして保存します。
C:\新規Microsoft Excel ワークシート(?).xlsの各シートのB列をC:\Target.xlsの同名のシートに集めるようになっています。
ファイル名は環境にあわせて適当に変えてください。

Const DstFileName = "C:\Target.xls"

Dim SrcFileName
Dim objXlsApp
Dim objDstXls
Dim objSrcXls
Dim objDstSht
Dim objSrcSht

Dim DstXlsList(4)
DstXlsList(0) = "C:\新規Microsoft Excel ワークシート.xls"
DstXlsList(1) = "C:\新規Microsoft Excel ワークシート (2).xls"
DstXlsList(2) = "C:\新規Microsoft Excel ワークシート (3).xls"
DstXlsList(3) = "C:\新規Microsoft Excel ワークシート (4).xls"
DstXlsList(4) = "C:\新規Microsoft Excel ワークシート (5).xls"

Set objXlsApp = CreateObject("Excel.Application")
Set objDstXls = objXlsApp.Workbooks.Open(DstFileName)

For Each SrcFileName In DstXlsList
Set objSrcXls = objXlsApp.Workbooks.Open(SrcFileName)

For Each objSrcSht In objSrcXls.Worksheets
Set objDstSht = FindSheet(objDstXls, objSrcSht)
If objDstSht Is Nothing Then
Set objDstSht = objDstXls.Worksheets.Add
objDstSht.Name = objSrcSht.Name
End If

CopyDataColumn objSrcSht, objDstSht
Next
objSrcXls.Close
Next

objDstXls.Close True, objDstXls.FullName
objXlsApp.Quit

Private Function FindSheet(objDstXls, objSrcSht)
Dim objDstSht

For Each objDstSht In objDstXls.Worksheets
If objDstSht.Name = objSrcSht.Name Then
Set FindSheet = objDstSht
Exit Function
End If
Next

Set FindSheet = Nothing
End Function

Private Sub CopyDataColumn(objSrcSht, objDstSht)
Dim objDstCell
Dim objSrcCell

Set objDstCell= objDstSht.Range("B2")
While objDstCell.Value <> ""
Set objDstCell = objDstCell.Offset(0, 1)
Wend

Set objSrcCell = objSrcSht.Range("B2")
While objSrcCell <> ""
objDstCell.Value = objSrcCell.Value
Set objSrcCell = objSrcCell.Offset(1, 0)
Set objDstCell = objDstCell.Offset(1, 0)
Wend
End Sub

蛇足ですがイミディエイトウインドウはVBAでは基本の分野にあたります。
インターネット等で調べてみるだけでなく、初期のうちは本を読むなどしたほうが理解がスムーズに行くと思います。

お礼

ご丁寧にありがとうございます
やってみます