新規シートを追加してから貼り付け

Excel VBA 試してみた クラスモジュール

昨日の記事で、次のような操作を行った。

  1. シート追加
  2. 配列貼り付け

infoment.hatenablog.com
日々、それなりに登場する操作だ。
唐突に、「毎回シートを追加する」のが面倒くさくなった。
そこで、配列をシートに貼り付ける関数に、新規にシートを作成するか否かの引数を追加してみた。

' 配列をシートへ貼り付け。
Public Function PasteArray(destination As Range, _
                  Optional paste_type As PasteType = ptRange, _
                  Optional to_new_sheet As Boolean = False) As ListObject

    ' 新規シート貼り付け指定の場合、アクティブなシートの直後に
    ' 新規シートを追加する。
    If to_new_sheet Then
        Sheets.Add After:=ActiveSheet
        
        ' Rangeオブジェクトは、引数として受け取った時点でのActiveSheetに
        ' 属している（らしい）。従って、追加シートに貼り付けたい場合は、
        ' 追加シートのアドレスで再セットする必要がある。
        Set destination = ActiveSheet.Range(destination.Address)
    End If

    Dim TargetRange As Range
    Set TargetRange = destination.Resize(rMax - rMin + 1, cMax - cMin + 1)
        TargetRange = source_array
    
    If paste_type = ptTable Then
        Dim TableName As String
            TableName = "Table_" & Format(Now, "yyyymmdd_hhmmss")
    
            ActiveSheet.ListObjects.Add(xlSrcRange, _
                                        TargetRange, _
                                        , _
                                        xlYes).Name = TableName
            Set PasteArray = ActiveSheet.ListObjects(TableName)
    End If
End Function

結果、昨日のコードのこの部分、

        Sheets.Add After:=ActiveSheet
        SQC.TargetArray(arr).PasteArray Range("A1"), ptRange

は、下記のとおり一行になった。

        SQC.TargetArray(arr).PasteArray Range("A1"), ptRange, True

たった一行のことだけど、塵も積もれば山となるってことで。

クラスモジュールの全文（最新版）はこちら。
infoment.hatenablog.com

参考まで。