[VBA]マクロで複数のブックの中のデータを別のベックの１つのシートにまとめる

こんにちは
同じフォルダ内のブック1,2,3,4,5......の[インボイス]というシートの中の色付けているタイトルの下の各データを保存先ブックの指定した場所にコピー貼り付けをしたいのです。

保存先のフォーマットはそのまま維持していただきたいのです。

一応一部分のマクロコードが下記通りですが、どうやって改善したらよろしいでしょうか？


Sub まとめ()
Set fso = CreateObject("scripting.filesystemobject")
Set SH = ActiveSheet
Application.ScreenUpdating = False
SH.UsedRange.Offset(1).ClearContents
For Each f In fso.getfolder(ThisWorkbook.Path).Files
If InStr(f.Name, ThisWorkbook.Name) = 0 Then
With Workbooks.Open(f)
.Sheets(2).UsedRange.Offset(1).Copy SH.Cells(Rows.Count, 1).End(3).Offset(1)
.Close False
End With
End If
Next f
Application.ScreenUpdating = True
End Sub

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2020/03/07 02:59

細かく見ていませんが、改善と言う事で

With Workbooks.Open(f)　の前でThisWorkbook.Nameを排除しているのは分かりますが
もっと限定をした方が好ましいと思います。
例えば
If InStr(f.Name, ThisWorkbook.Name) = 0 and InStr(f.Name, "invoice") > 0 Then みたいに、場合によっては拡張子なども含める
必要ないかも知れませんが、開いている場合の想定も入れた方が良いと思います。

.Sheets(2).UsedRange.ですが、これはセルの塊を示します。
つまり、画像を見ると範囲が一致していません。（7列を5列に）
.Sheets(2).UsedRange.Offset(1).Copy SH.Cells(Rows.Count, 1).End(3).Offset(1)をどうするかですね。

UsedRangeを使うなら、あまり勧められませんが、ThisWorkbook　側のDとE列の間に２列挿入して表組みを変え
７列に合わせると言う考え方です。

または、UsedRangeを諦め、最終行取得して範囲を2つ抽出する方法をとるか、、、
CurrentRegion、SpecialCellsも画像を見る限り難しいかと思いますし、悩ましいですね。