[[20051108000435]] 『複数のブックのデータを一つにまとめたい。』(困ったさん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数のブックのデータを一つにまとめたい。』(困ったさん)

フォルダ名【個人用】に入っている400ほどある全てのブックの、指定したシートの、指定したセルからデータを抜き出して、
別の1つのブックにリストとして出力・書き込みしたいのです。
400あるブックの指定したいシート名は全て【個人計算用】。
データが欲しいセル番地は仮に【A1(文字)、B2(文字)、C3(数値)、D4(数値)、E5(数値)、F6(数値)】として6箇所づつあります。
リストとして書き込みたいブックのシートには、6個のデータを1行に書き込みたいのです×400列。
全部伝えられたか不安ですが・・・。
マクロはほとんど経験が無く、こんなに難しいものは操れないので困っています。
過去ログを見たのですが、記述自体が何を書いているのかまだ理解が出来なくて。
どなたかお願いいたします。
XP、Excel2003


 VBAを使うことになると思いますけど、ひとつだけ問題点があります。
 エクセルで扱える列数は256列までです。
 400列は書き出せませんが・・・・。

 (川野鮎太郎)


川野さん、ありがとうございます。
間違えました。400列ではなく、400行でした。すみません。


 ファイル名も書き出したほうが良かったでしょうか・・・?
 
Sub Test()
Dim MyObj As Object
Dim MyFileName As String
Dim MyDir As String
Dim MySheet As Worksheet
Dim MyWb As Workbook
Dim MyCount As Long
Dim MyVal() As Variant
Application.ScreenUpdating = False
With ThisWorkbook.ActiveSheet
    Set MyObj = CreateObject("Shell.Application"). _
                BrowseForFolder(0, "フォルダを選択してください", 0)
    If MyObj Is Nothing Then Exit Sub
    MyDir = MyObj.Items.Item.Path & "\"
    MyFileName = Dir(MyDir & "*.xls")
        Do
        ReDim Preserve MyVal(5, MyCount)
            Set MyWb = Workbooks.Open(MyDir & MyFileName)
            On Error Resume Next
            'Sheets.Add.Name = "個人計算用"
            With MyWb.Worksheets("個人計算用")
                MyVal(0, MyCount) = .Range("A1").Value
                MyVal(1, MyCount) = .Range("B2").Value
                MyVal(2, MyCount) = .Range("C3").Value
                MyVal(3, MyCount) = .Range("D4").Value
                MyVal(4, MyCount) = .Range("E5").Value
                MyVal(5, MyCount) = .Range("F6").Value
            End With
            On Error GoTo 0
            MyWb.Close False
            MyFileName = Dir()
            MyCount = MyCount + 1
        Loop Until MyFileName = vbNullString
        .Range(Cells(1, 1), Cells(MyCount + 1, 6)).Value = Application.Transpose(MyVal)
Set MyObj = Nothing
Application.ScreenUpdating = True
End With
End Sub

 新しいブックに上のコードを貼り付けてTestを試してみてください。

 (川野鮎太郎)


川野様、ありがとうございました。
あっと言う間に処理できて、感動いたしました。
ほんとーに感動しました。
(困ったさん)


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.