40本目 複数ブックの統合

VBA100本ノック

VBA100本ノック 40本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ


問題

#VBA100本ノック 40本目
「data」フォルダ内のExcelファイルについて、シート「2020年12月」のA1からの連続表範囲を集めます。※このシートが無いファイルもある。
自身の既存シート「2020年12月」に集めてください。
1行目は見出しなので2件目からは除く。
※ブック指定と「data」のパス位置は任意

解答

Sub ノック40本目()

    Dim wsX As Worksheet, lastrow As Long: Set wsX = ThisWorkbook.Sheets("2020年12月")
    Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")

    Dim wbA As Workbook, fl
    For Each fl In fso.getfolder(ThisWorkbook.Path).Files
        If fso.getextensionname(fl) = "xlsx" Then
            Set wbA = Workbooks.Open(fl)
            Dim ws As Worksheet
            For Each ws In wbA.Sheets
                If ws.Name = "2020年12月" Then
                    lastrow = wsX.Cells(Rows.Count, 1).End(xlUp).Row
                    If wsX.Range("A1") = "" Then
                        ws.Range("A1").CurrentRegion.Copy wsX.Range("A1")
                    Else
                        ws.Range("A1").CurrentRegion.Offset(1).Copy wsX.Range("A" & lastrow + 1)
                    End If
                End If
            Next
        wbA.Close
        End If
    Next
    

End Sub
新人君
新人君

ブックに限らず
色々活用できそうなコードですね!

ブチョ
ブチョ

そうかな?
俺はそうは思わないよ!

新人君
新人君

コメント

タイトルとURLをコピーしました