ブック名、シート名、印刷枚数、印刷用紙を書き出すマクロ。

ブック名、シート名、印刷枚数、印刷用紙を書き出すマクロ。太字は適宜かいへんしてください。A4しか識別しないようになってます。

Sub CopySheetInfoToGETRIST()
    Dim ws As Worksheet
    Dim getristSheet As Worksheet
    Dim rowNum As Long
    
    ' アクティブなブックを取得
    Set activeBook = ActiveWorkbook
    
    ' GETRISTシートを取得
    On Error Resume Next
    Set getristSheet = activeBook.Sheets("GETRIST")
    On Error GoTo 0
    
    ' GETRISTシートが存在しない場合は新しく作成
    If getristSheet Is Nothing Then
        Set getristSheet = activeBook.Sheets.Add
        getristSheet.Name = "GETRIST"
    End If
    
    ' GETRISTシートのヘッダーを設定
    getristSheet.Range("D1").Value = "シート名"
    getristSheet.Range("E1").Value = "印刷枚数"
    getristSheet.Range("F1").Value = "用紙サイズ"
    getristSheet.Range("G1").Value = "ブック名"
    
    ' GETRISTシートの最終行を取得
    rowNum = getristSheet.Cells(getristSheet.Rows.Count, "D").End(xlUp).Row + 1
    
    ' 各シートの情報をGETRISTシートに貼り付け
    For Each ws In activeBook.Worksheets
        ' シート名をD列に貼り付け
        getristSheet.Cells(rowNum, "D").Value = ws.Name
        
        ' 印刷枚数をE列に貼り付け
        getristSheet.Cells(rowNum, "E").Value = ws.PageSetup.Pages.Count
        
        ' 用紙サイズをF列に貼り付け
        Select Case ws.PageSetup.PaperSize
            Case xlPaperLetter
                getristSheet.Cells(rowNum, "F").Value = "Letter"
            Case xlPaperA4
                getristSheet.Cells(rowNum, "F").Value = "A4"
            ' 他の用紙サイズについても必要なだけCase文を追加
            Case Else
                getristSheet.Cells(rowNum, "F").Value = "Unknown"
        End Select
        
        ' ブック名をG列に貼り付け
        getristSheet.Cells(rowNum, "G").Value = activeBook.Name
        
        ' 次の行に移動
        rowNum = rowNum + 1
    Next ws
    
    MsgBox "情報の貼り付けが完了しました。", vbInformation
End Sub

目指せ統計生活。昨日の改良版。