[[20141121155257]] 『値の貼り付けができない』(あきなな) ページの最後に飛ぶ

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

 

『値の貼り付けができない』(あきなな)

マクロを実行しているしているシートのA1にはフォルダパス、A5から下にファイル名が記載されています。ファイル数が何個になるかは都度違います。
このファイルを順に開いてセルB7からD列の使用最終行までコピーし、マクロを実行しているシートのD列を起点に値のみ貼り付けをしたいのです。
開きたいファイル名やシート名は都度違います。

下記のようなマクロを作成しましたが、ファイルは開くのですが、値の貼り付けができません。エラーは出ません。
マクロ初心者です。
よろしくお願いします。

Sub データコピーb()

    Dim fPath As String   'フォルダのフルパス
    Dim fName As String   'ファイル名
    Dim aSheet As Worksheet 
    Dim i As Long         'ファイル名の行番号
    Dim lngRow As Long    '貼り付け行(最終行+1)

    Set aSheet = ActiveSheet     
    fPath = aSheet.Range("A1").Value & "\"

    i = 5
    Do
        fName = aSheet.Cells(i, "A").Value 

        If Len(fName) = 0 Then Exit Do

        Workbooks.Open fPath & fName 
        Range("B7", Cells(Rows.Count, "D").End(xlUp)).Copy

        With ThisWorkbook.Sheets("BOM読み込み")
            lngRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1
            .Range("D" & lngRow).PasteSpecial Paste:=xlPasteValues
        End With
        i = i + 1

    Loop

End Sub

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


 この続きでしょうか。
[[20141120224013]] 『セルに記載されたフォルダパスを使用しファイルを』(ゆうママ)

 ニックネームは統一していただければと思います。

(Mook) 2014/11/21(金) 17:53


 衝突しましたが、せっかく書いたので投稿しておきます。
 値の貼り付けでしたら、一度配列に取り込んでしまい、出力されてはどうでしょうか?
    Sub データコピーb()
        Dim fPath As String   'フォルダのフルパス
        Dim fName As String   'ファイル名
        Dim aSheet As Worksheet
        Dim i As Long         'ファイル名の行番号
        Dim lngRow As Long    '貼り付け行(最終行+1)
        Dim 貼付データ '★
        Set aSheet = ActiveSheet
        fPath = aSheet.Range("A1").Value & "\"
        i = 5
        Do
            fName = aSheet.Cells(i, "A").Value
            If Len(fName) = 0 Then Exit Do
            Workbooks.Open fPath & fName
            貼付データ = Range("B7", Cells(Rows.Count, "D").End(xlUp)).Value '★
            With ThisWorkbook.Sheets("BOM読み込み")
                .Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(貼付データ, 1)).Value = 貼付データ '★
            End With
            i = i + 1
        Loop
    End Sub

 ★が変更点です
(稲葉) 2014/11/21(金) 17:55

 衝突しましたが、せっかく書いたので投稿しておきます。×2

 稲葉さんの回答がでたので、蛇足も良いところですが、ファイルを閉じるところだけ
 おまけという事で。

 Sub Sample()
    Dim aSheet As Worksheet
    Set aSheet = ActiveSheet

    Dim fPath
    fPath = aSheet.Range("A1").Value & "\"

    Dim fName
    Dim i
    i = 5
    Do
        fName = aSheet.Cells(i, "A").Value
        If fName = "" Then Exit Do
        With Workbooks.Open(fPath & fName)
            With .Worksheets(1)
                .Range("B7", .Cells(Rows.Count, "D").End(xlUp)).Copy
            End With
            With ThisWorkbook.Sheets("BOM読み込み")
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            End With
            .Close False
         End With
         i = i + 1
    Loop While fName <> ""
 End Sub

(Mook) 2014/11/21(金) 18:17


コメント返信:

[ 一覧(最新更新順) ]


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