１０件転記したら、シートを変えて転記再開。

職場で、このような相談を受けた。

• ある表からある帳票に、データを10件ずつ貼り付けたい。
• 毎回、データ数は異なる。
  ５件の時もあれば、55件の時もある。

パソコンが無かったので、この時はホワイトボードに書いて説明した。
本当にそれでうまくいくか、簡易的に検証してみる。

作戦は、こうだ。

1. 転記するデータをまず全て、一つの配列に格納する。
2. 上記配列から、一行ずつスライスして取り出す。
3. 取り出した配列を順次、帳票に貼り付ける。
   １０件貼り付けた時点で、シートを追加した一行目から貼り付け再開。

上記にのっとって、作成したのがこちら。

Sub Sample()
    Dim SourceArray() As Variant
        SourceArray = ActiveSheet.UsedRange.Value
                
    Dim i As Long
    
    ' ループ回数（１０レコード一組）
    Dim iMax As Long
        iMax = WorksheetFunction.RoundUp(UBound(SourceArray) / 10, 0)
    
    Dim arr As Variant
        Sheets.Add After:=ActiveSheet
        For i = 1 To UBound(SourceArray)
            
            ' 配列をスライス。
            arr = WorksheetFunction.Index(SourceArray, i, 0)
            
            ' スライスした配列を貼り付け。
            Cells(((i - 1) Mod 10) + 1, 1).Resize(, UBound(SourceArray, 2)) = arr
            
            ' １０件転記したら、シート追加。
            If i Mod 10 = 0 Then
                Sheets.Add After:=ActiveSheet
            End If
        Next
End Sub

今回もっともヤヤコシイのは、この部分だろうか。

((i - 1) Mod 10) + 1

10を超えた時点で、また1から循環する。「10」という区切りの良い数字なら、Right関数で左の１文字を抽出しても、良いかもしれない。

それで、結果はこのようになった。

結果は、まずまず。実際の帳票に合わせて修正すれば、何とか行けそうです。

参考まで。