ファイル読み込みVBA～ひな形シート、ひな形ファイルをつくる

プロンプト by わたし

以下要件をVBAでコーディングしてください
・ブック「ひな形」のシート「list」A列に列挙された文字列を読みとり、
ブック「SS書」からシート名がおなじ文字列のシートから
XーＺ列の5行目から一番下の行までをコピーし（※）、
ブック「ひな形」にその文字列のシート名のシートを作成して
そのシートの1ー３行目に、縦と横を入れ替え転記する。この1ー３行目を「項目行」と呼ぶ

（※）結果が実現できれば、コピーしなくても構わない。

・項目行に「FILLER」という項目がある場合、その列は削除する。（左につめる）

・項目行のなかで「終期年月日」の文字列を探し、黄色にする

generate by chatGPT

Sub ProcessSheets()
    Dim wbSource As Workbook
    Dim wbTemplate As Workbook
    Dim wsList As Worksheet
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim itemName As String
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rngSource As Range
    Dim rngDest As Range
    Dim colIndex As Long
    Dim headerRow As Range
    Dim cell As Range
    
    ' ブックを設定
    Set wbTemplate = ThisWorkbook
    Set wbSource = Workbooks("SS書.xlsx") ' 「SS書」のブック名を変更する場合はここを編集
    Set wsList = wbTemplate.Sheets("list")
    
    ' A列に列挙されたシート名を順に処理
    Dim i As Long
    For i = 1 To wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Row
        itemName = wsList.Cells(i, "A").Value
        
        ' シートが存在するか確認
        On Error Resume Next
        Set wsSource = wbSource.Sheets(itemName)
        On Error GoTo 0
        If wsSource Is Nothing Then
            MsgBox "シート '" & itemName & "' が見つかりません。", vbExclamation
            Set wsSource = Nothing
            GoTo NextSheet
        End If
        
        ' コピー範囲を特定
        lastRow = wsSource.Cells(wsSource.Rows.Count, "X").End(xlUp).Row
        lastCol = wsSource.Cells(5, wsSource.Columns.Count).End(xlToLeft).Column
        Set rngSource = wsSource.Range(wsSource.Cells(5, 24), wsSource.Cells(lastRow, lastCol)) ' X列=24, Z列も含む
        
        ' 新しいシートを作成
        On Error Resume Next
        Set wsNew = wbTemplate.Sheets(itemName)
        If wsNew Is Nothing Then
            Set wsNew = wbTemplate.Sheets.Add(After:=wbTemplate.Sheets(wbTemplate.Sheets.Count))
            wsNew.Name = itemName
        End If
        On Error GoTo 0
        
        ' 縦横入れ替え転記
        Set rngDest = wsNew.Cells(1, 1)
        rngDest.Resize(rngSource.Columns.Count, rngSource.Rows.Count).Value = Application.WorksheetFunction.Transpose(rngSource.Value)
        
        ' 項目行を設定
        Set headerRow = wsNew.Rows(1)
        
        ' 「FILLER」の列を削除
        For colIndex = headerRow.Cells(headerRow.Cells.Count).Column To 1 Step -1
            If wsNew.Cells(1, colIndex).Value = "FILLER" Then
                wsNew.Columns(colIndex).Delete Shift:=xlToLeft
            End If
        Next colIndex
        
        ' 「終期年月日」を黄色にする
        For Each cell In headerRow
            If cell.Value = "終期年月日" Then
                cell.Interior.Color = RGB(255, 255, 0)
            End If
        Next cell
        
NextSheet:
        ' 次のシートへ
        Set wsSource = Nothing
        Set wsNew = Nothing
    Next i
    
    MsgBox "処理が完了しました。", vbInformation
End Sub

chatGPTからのコメント

説明

1. ブックとシートの設定

   • wbTemplateで「ひな形」を、wbSourceで「SS書」を設定。
   • wsListで「list」シートを設定。

2. A列に列挙された文字列をループ

   • 各行の文字列をシート名として処理。

3. コピー範囲の設定

   • 元のシートのX-Z列の5行目から最下行を範囲として特定。

4. 新しいシートを作成

   • シート名で存在チェック後、新規作成（既に存在する場合はスキップ）。

5. 縦横入れ替え

   • Transposeを使用して転記。

6. 「FILLER」列の削除

   • 右端列から逆順に走査して「FILLER」があれば削除。

7. 「終期年月日」の強調

   • 該当文字列を検索して黄色で塗りつぶし。

エラー処理も含んでいますので、シートが見つからない場合でもスキップして次のシートへ進みます。