-ChatGPT-4「VBAで選択したセルの下に行を挿入して別のシートから設定通り値を代入」と頼んだら

-ChatGPT-4への質問

-ChatGPT-4

選択したセルの下に行を挿入して別のシートから設定通り値を代入

-ChatGPT-4の回答

'セル選択行下行挿入データ代入＋２行目以降から貸方に消費税　対象外　金額　0代入　日付をコピペ インプットボックスでセル選択　新たに変更した特定のセルに色をつける
Sub InsertRowsAndTransferData6()
    Dim currentSheet As Worksheet
    Dim sourceBook As Workbook
    Dim SourceSheet As Worksheet
    Dim DestSheet As Worksheet
    Dim sourceLastRow As Long
    Dim numRows As Long
    Dim fileName As Variant
    Dim i As Long
    Dim selectedRow As Range
    Dim copiedValue As Variant
    
    ' 現在のシートを設定します
    Set currentSheet = ActiveSheet
    
     ' インプットボックスで選択したセルを取得します
    On Error Resume Next ' キャンセルを押されたときのエラーを無視する
    Set selectedRow = Application.InputBox("行を選択してください", Type:=8)
    On Error GoTo 0 ' エラー制御を戻す
    If selectedRow Is Nothing Then Exit Sub ' キャンセルを押されたときは処理を終了する
    
    ' ソースブックのファイルを選択します
    MsgBox "社会保険支払シートを含むExcelファイルを選択してください"
    fileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    If fileName = False Then Exit Sub ' ユーザーがキャンセルした場合、マクロを終了します
    
    ' 選択したファイルを開きます
    Set sourceBook = Workbooks.Open(fileName)
    
    ' ソースシートを設定します
    Set SourceSheet = sourceBook.Sheets("社会保険支払")
    
    ' 目的のシートを設定します
    Set DestSheet = currentSheet
    
    ' ソースシートの最終行を取得します
    sourceLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 挿入する行数を計算します
    numRows = (sourceLastRow - 1) * 2 - 1
    
    ' 選択したセルの下に行を挿入します
    DestSheet.Rows(selectedRow.Row + 1 & ":" & selectedRow.Row + numRows).Insert Shift:=xlDown
    
    ' データを転送します
    Dim lastColDest As Long
    lastColDest = DestSheet.Cells(1, DestSheet.Columns.Count).End(xlToLeft).Column
    
    For i = 2 To sourceLastRow
        ' 以下の値は、選択した行の値を維持します
        copiedValue = DestSheet.Cells(selectedRow.Row, lastColDest - 10).Value

        ' データを挿入する新しい行にデータを代入します
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2, lastColDest - 10).Value = copiedValue
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2 + 1, lastColDest - 10).Value = copiedValue
        ' 以下、データを追加します
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2, lastColDest - 9).Value = SourceSheet.Cells(i, 1).Value
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2 + 1, lastColDest - 9).Value = SourceSheet.Cells(i, 4).Value
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2, lastColDest - 7).Value = "対象外"
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2 + 1, lastColDest - 7).Value = "対象外"
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2, lastColDest - 6).Value = SourceSheet.Cells(i, 2).Value
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2 + 1, lastColDest - 6).Value = SourceSheet.Cells(i, 5).Value
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2, lastColDest - 1).Value = SourceSheet.Cells(i, 3).Value
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2 + 1, lastColDest - 1).Value = SourceSheet.Cells(i, 6).Value

        ' 選択行の1行下から挿入された行数だけ0を代入します
        DestSheet.Cells(selectedRow.Row + 1, lastColDest - 2).Resize(numRows).Value = 0

        ' 最終列から3列目に"対象外"という文字列を挿入します
        DestSheet.Cells(selectedRow.Row + 1, lastColDest - 3).Resize(numRows).Value = "対象外"
        
        ' 新たに追加された特定のセルの背景色を赤にします
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2, lastColDest - 10).Interior.Color = RGB(255, 0, 0)
        DestSheet.Cells(selectedRow.Row + (i - 2) * 2 + 1, lastColDest - 10).Interior.Color = RGB(255, 0, 0)
    Next i
    
    ' ソースブックを閉じます
    sourceBook.Close SaveChanges:=False
End Sub