各シートにシート名を記載(最終列に新しい列を挿入してシート名記載)

Sub 各シートに新しい列を挿入して最終行までシート名を記載()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim newCol As Integer
    
    ' 各シートに対してループ
    For Each ws In Worksheets
        ' シートの最終行を取得
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
        
        ' 新しい列を挿入
        newCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1
        ws.Columns(newCol).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ' 新しく挿入した列（最終行まで）にシート名を記載
        ws.Range(ws.Cells(1, newCol), ws.Cells(lastRow, newCol)).Value = ws.Name
    Next ws
End Sub