[[20190314191054]]　『複数ファイルをまとめるマクロについて』（はなちゃん）　ページの最後に飛ぶ

『複数ファイルをまとめるマクロについて』（はなちゃん）

複数ファイルをまとめるマクロを作成しましたが、
複数あるエクセルファイル「xlsx」からマクロファイル「xlsm」に変わりました。、
開いた時にメッセージがでるマクロなので、結合には関係ないと思いますが、
マクロが動かなくなりました。

Sub Sample()
Dim fpath As String, fname As String
Dim wb As Workbook
Dim sh As Worksheet
Dim i As Long
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets("Sheet1")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
fpath = .SelectedItems(1) & "\"
End With
fname = Dir(fpath & "*.xlsx", vbNormal)
Do Until fname = ""
Set wb = Workbooks.Open(fpath & fname)
With wb.Worksheets("管理表")
i = sh.Cells(Rows.Count, "B").End(xlUp).Row + 1
.Range("B14:AF" & .Cells(Rows.Count, "B").End(xlUp).Row).Copy Destination:=sh.Range("B" & i)
End With
wb.Close
fname = Dir()
Loop
Application.ScreenUpdating = True
End Sub

どこを修正すれば良いでしょうか？

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

＞fname = Dir(fpath & "*.xlsx", vbNormal)

すでに試したかもしれませんが、
ここを、xlsm　にしてみては。

（マナ） 2019/03/14(木) 20:07

質問については、同名でxlsm xlsx 両方が存在しているので分けなきゃいけないのであれば、マナさんのコメントのとおりな気がします。

逆に、xlsm xlsx、xlsなどのExcelブックであればとりあえず処理の対象にしてしまってよいのであれば、

 fname = Dir(fpath & "*.xls", vbNormal)

としてしまえばよいとおもいます。

【参考】

 Dir関数の注意点
http://officetanaka.net/excel/vba/tips/tips69.htm

このほかインデントついてなくて見づらかったので、コメント付けつついくつか直してみました。
データ用意するのがめんどくさいので、コンパイルエラーにならないかのチェックしかしてないですが、興味があれば、ステップ実行して研究してみてください。

※この程度で十分という意味ではありません。
　あくまで、私がわかる範囲での一例です。

    Sub Sample()
        Dim fpath As String, fname As String
        Dim dstRNG  As Range

        Stop '←ブレークポイントの代わり

        '▼出力先セルをセット
        With ThisWorkbook.Worksheets("Sheet1")
             Set dstRNG = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
        End With

        '▼ダイアログで検索対象のフォルダを取得
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = False Then
                Exit Sub
            Else
                fpath = .SelectedItems(1) & "\"
            End If
        End With

        '▼Dir関数で検索対象フォルダ内にあるExcelブックを探す
        fname = Dir(fpath & "*.xls", vbNormal)
        Do Until fname = ""

            '▼見つかったブックを開いて管理表シートの
            With Workbooks.Open(fpath & fname).Worksheets("管理表")

                '▼B14セル～B列最終行のセル範囲をAF列まで拡張した範囲をコピーして
                '　出力先セルへ貼付
                .Range("B14", .Cells(.Rows.Count, "B").End(xlUp)).Resize(, 31).Copy Destination:=dstRNG
                End With

                '親（開いたブック）を閉じる
                .Parent.Close
            End With

            '▼出力先セルをセット（次のコピペの準備)
            With ThisWorkbook.Worksheets("Sheet1")
                Set dstRNG = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
            End With

            '▼次のブックを探して「fname」に代入
            fname = Dir()

        Loop

    End Sub

（もこな２） 2019/03/14(木) 21:01

コメント返信：

[ 一覧(最新更新順) ]

[[20190314191054]] 『複数ファイルをまとめるマクロについて』（はなちゃん） ページの最後に飛ぶ

[[20190314191054]]　『複数ファイルをまとめるマクロについて』（はなちゃん）　ページの最後に飛ぶ