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

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

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

新人君
…
コメント