Excelの画面作成（部品部分の組み合わせ）
前提
下記記載のマクロは、Office365(2024/12/01)時点のものを利用しています。
マクロは、生成AIChat Gptを利用して生成したものを修正しました。
実行結果は確認済みです。
経緯
顧客先より、画面を複数のコンポーネント（部品）に分けて、
ステータスや分類ごとに表示されるレイアウトが違うといった具合で、かなりややこしい作りとなりました。
最初は、手で作っておりましたが、マクロを作成して、管理することとしました。
注意事項
・サンプルのExcelファイルをダウンロードをしてください。
https://github.com/HiHiroyoshi/excelAndCommentMacro-ScreenComportnent-
（ファイル名20241201ScreenLayout.xlsx）
マクロは、20241201_macroProgram.txtに記載しています。
・マクロの有効化
マクロを実行するには、Excelで「マクロ有効化」の設定が必要です。
手順概要
A. 準備）開発メニューを表示
B. VBAマクロの操作画面を表示
C. マクロを貼り付けて、実行
D. ファイルの保存を行う
E. まとめ
A. 準備）開発メニューを表示
（既に開発メニューがある場合は、不要です）。
1.Excelを開く
2.ファイルメニューをクリック
3.オプションをクリック（筆者ノートPCでは、その他の中にありました）
4.Excelのオプションのリボンのユーザー設定をクリック
5.リボンのカスタマイズをします。右側リボンのユーザー設定（B）のメインタブの開発にチェックを入れる
6.OKをクリック
7.開発メニューが表示されます。
B. VBAマクロの操作画面を表示
1.開発タブをクリック
2.表示されるVisual Basicをクリック
3.新たに画面が表示されます。
（難しい印象を持たれる方もいるかと思いますが、行う操作は、ごく一部です。）
4.上側挿入メニューをクリック
5.標準モジュールをクリック
表示された画面に、マクロを貼り付けて実行する形となります。
C. マクロを貼り付けて、実行
1.下記のプログラムをコピー（あるいは、gitのtxtファイルの内容をコピー）して、貼り付けをしてください。
Sub CreateSheetsWithData()
Dim wsSheetList As Worksheet
Dim wsMaster As Worksheet
Dim wsSheet2 As Worksheet
Dim newWorkbook As Workbook
Dim newSheet As Worksheet
Dim lastRowSheetList As Long
Dim lastColSheetList As Long
Dim i As Long, j As Long
Dim sheetName As String
Dim componentSheet As String
Dim identifier As String
Dim startPos As String, endPos As String
Dim rowCount As Long, colCount As Long
Dim targetRange As Range
Dim pasteRow As Long
Dim partSheetName As String
' 元のシートを設定
Set wsSheetList = ThisWorkbook.Sheets("SheetList")
Set wsMaster = ThisWorkbook.Sheets("Master")
' SheetListの最終行と列を取得
lastRowSheetList = wsSheetList.Cells(wsSheetList.Rows.Count, "C").End(xlUp).Row
lastColSheetList = wsSheetList.Cells(2, wsSheetList.Columns.Count).End(xlToLeft).Column
' 新しいブックを作成
Set newWorkbook = Workbooks.Add
' シートリストをループ
For i = 4 To lastRowSheetList
sheetName = wsSheetList.Cells(i, "C").Value
If sheetName <> "" Then
' 新しいシートを作成
Set newSheet = newWorkbook.Sheets.Add(After:=newWorkbook.Sheets(newWorkbook.Sheets.Count))
newSheet.Name = sheetName
' 必要な部品情報を取得
For j = 4 To lastColSheetList
componentSheet = wsSheetList.Cells(2, j).Value
identifier = wsSheetList.Cells(i, j).Value
' 識別番号が入力されている場合、Masterシートを検索
If componentSheet <> "" And identifier <> "" Then
Dim k As Long
Dim lastRowMaster As Long
lastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, "C").End(xlUp).Row
' Masterシートを検索
For k = 3 To lastRowMaster
' 部品シート名と識別番号が一致する行を判定
If wsMaster.Cells(k, "C").Value = componentSheet And _
wsMaster.Cells(k, "D").Value = identifier Then
' 部品シート名を取得
partSheetName = wsMaster.Cells(k, "C").Value
Set wsSheet2 = ThisWorkbook.Sheets(partSheetName)
' 対応するデータを取得
startPos = wsMaster.Cells(k, "E").Value
endPos = wsMaster.Cells(k, "H").Value
' 範囲をコピー
If startPos <> "" And endPos <> "" Then
On Error Resume Next ' エラー回避用
Set targetRange = wsSheet2.Range(startPos & ":" & endPos)
On Error GoTo 0
If Not targetRange Is Nothing Then
' 貼り付け先の行を取得
pasteRow = newSheet.Cells(newSheet.Rows.Count, 12).End(xlUp).Row + 1
' 部品シート名を記載
newSheet.Cells(pasteRow, 1).Value = "部品シート名: " & partSheetName
pasteRow = pasteRow + 1
' データを貼り付け
targetRange.Copy
newSheet.Cells(pasteRow, 12).PasteSpecial Paste:=xlPasteAll
End If
Else
Debug.Print "無効な範囲: " & startPos & " - " & endPos
End If
End If
Next k
End If
Next j
End If
Next i
' 新しいブックを保存
Application.CutCopyMode = False
MsgBox "新しいブックが作成されました。" & vbCrLf & "内容を確認してください。", vbInformation
End Sub
2.実行メニューをクリック
3.Sub/ユーザーフォームの実行 F5をクリック
→マクロが実行されます。
実行後、下記のポップアップが表示されます。
以上が、作成作業です。
D. ファイルの保存を行う
マクロ実行後、Excelを保存する際に、下記の表示がされます。
・マクロも含めて保存を行う（拡張子.xlsm）
・実行したマクロは保存しない(拡張子.xlsx)
どちらかでの保存という形となります。
→実行したマクロは保存しないため、機能の保存と消去をクリックしてください。
以上となります。
E. まとめ
マクロを利用することで、手動で同じような画面構成を変更や修正する手間が省けます。