有江's IT 4コマ漫画 【第８５４話：簡単なプログラムはChatGPTに依頼しましょう！】

ITネタの4コマ漫画! IT向上委員会:有江が発信中!



4コマ漫画
どもども、有江です。


通常は、ChatGPTに下書きしてもらって
ちょいと手を加えて仕上げるんですが
今回、修正せずに使えて、ちょっとビックリ
これは、もう戻れませんね～


Sub MergeSheets()
    Dim ws As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim pasteRow As Long
    Dim rng As Range
    
    ' 新規シートを作成（既に存在する場合は削除して再作成）
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("MergedData").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set newSheet = ThisWorkbook.Sheets.Add
    newSheet.Name = "MergedData"
    
    pasteRow = 1 ' 貼り付け開始行
    
    ' すべてのシートをループ
    For Each ws In ThisWorkbook.Sheets
        ' 結合用シートはスキップ
        If ws.Name <> newSheet.Name Then
            ' データの最終行と最終列を取得
            lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
            
            If lastRow > 1 Then ' データがある場合
                Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
                
                ' 1シート目のみヘッダーをコピー
                If pasteRow = 1 Then
                    rng.Copy newSheet.Cells(pasteRow, 1)
                    pasteRow = newSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
                Else
                    rng.Offset(1, 0).Resize(lastRow - 1, lastCol).Copy newSheet.Cells(pasteRow, 1)
                    pasteRow = newSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
                End If
            End If
        End If
    Next ws
    
    MsgBox "データを統合しました", vbInformation
End Sub


ではでは。


有江's IT 4コマ漫画 【第８５３話：「パーフェクトピッチチャレンジ」というスマホゲームが面白い】　目次　有江's IT 4コマ漫画 【第８５５話：iPod nano、まだ使いたい！】

© 2025 Takahiro Arie