[[20150324204822]] 『複数ファイルのシートをコピーして1つにまとめる』(はる) ページの最後に飛ぶ

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

 

『複数ファイルのシートをコピーして1つにまとめるマクロについて』(はる)

同一フォルダに入っている複数のファイル(100個以上・総て同じフォーマット・マクロ有効ブック)からシート名「A」だけをコピーして1つのファイルにまとめるマクロを使っています。
コピー元のファイルのシート「A」には数式やマクロボタンやリンクが含まれているのですが、このマクロだとデータと一緒にそれらを全部コピーしてきます。

シート「A」のデータだけを値貼り付けでコピーしてくるにはどうしたら良いのでしょうか?

教えてください、よろしくお願いいたします。

************************

Sub すべてのブックから特定のシートを取り込む()

    Set ファイルシステム = CreateObject("Scripting.FileSystemObject")

    あるブック = Application.GetOpenFilename("Excelファイル(*.xlsm),*.xlsm")

    Set 親フォルダ = ファイルシステム.GetFile(あるブック).ParentFolder

        For Each ファイル In 親フォルダ.Files

            Workbooks.Open Filename:=ファイル.Path, UpdateLinks:=0

            ブック名 = ActiveWorkbook.Name

            ActiveWorkbook.Worksheets("A").Copy After:=ThisWorkbook.Worksheets("まとめ") '//シート名「まとめ」の後ろに貼り付ける

            Workbooks(ブック名).Close False

    Next

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 なぜかレスがつきませんね。

 「リンク」が、具体的にどういうものなのか、あるいは数式で参照しているところはどこなのかがわかりにくいのですが
 方法としては、ThisWorkbook側でシートを追加して、そこに読み込んだブックのシートから値を転記。

 あるいは、シートコピーした後に、ThisWorkbook側で不要なコントロールを削除するなり数式を値に変えるなり。

 自分がやるなら前者です。さらに、シートモジュールがあるなら前者が必須でしょうね。

(β) 2015/03/24(火) 23:58


 A シートに、どんな付属物があるのか不明ですが、たたき台です。

 Sub Test()

    Dim Fso As Object
    Dim fName As String
    Dim pFolder As Object
    Dim mBook As Object
    Dim yrBook As Workbook
    Dim shA As Worksheet
    Dim shN As Worksheet

    Application.ScreenUpdating = False

    Set Fso = CreateObject("Scripting.FileSystemObject")

    fName = Application.GetOpenFilename("Excelファイル(*.xlsm),*.xlsm")
    If fName = "False" Then Exit Sub

    Set pFolder = Fso.GetFile(fName).ParentFolder

    For Each mBook In pFolder.Files

        Set yrBook = Workbooks.Open(Filename:=mBook.Path, UpdateLinks:=0)

        On Error Resume Next
        Set shA = Nothing
        Set shA = yrBook.Sheets("A")
        On Error GoTo 0

        If Not shA Is Nothing Then

            Set shN = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets("まとめ"))
            With shA.UsedRange
                shN.Range(.Address).Value = .Value
            End With
        End If

        yrBook.Close False

    Next

End Sub

(β) 2015/03/25(水) 07:25


βさま、

試してみたところ、私がリクエストした通りの動きをしました。
本当にありがとうございました!
(はる) 2015/03/25(水) 14:05


コメント返信:

[ 一覧(最新更新順) ]


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