excle vba 编排乘车表

Sub 座位表()

    Dim i, ii, x As Integer

    Application.ScreenUpdating = False

    Sheets("座次表").Range("A3:D13,F3:K13").ClearContents

    arr = Array("A", "C", "F", "H", "j")

    x = 3

    ii = 0

    For i = 3 To Sheet1.Range("b65536").End(3).Row

        If ii = 5 Then

            ii = 0

            x = x + 1

        End If

        Sheet1.Range("b" & i & ":c" & i).Copy Sheet4.Range(arr(ii) & x)

        ii = ii + 1

    Next

    Application.ScreenUpdating = True

    MsgBox ("生产完毕")

End Sub