Заполнить таблицу Word за один заход

Sub Макрос3()
 
    Dim tbl$, t$, z As Long
    Start = Time()
    For i% = 1 To 2000 ' строк
        For j% = 1 To 10 ' солонок
            z = CDbl(i + 1000 * j)
            t = CStr(z)
            If j = 1 Then
                tbl = IIf(Len(tbl) = 0, t, tbl & t)
            Else
                tbl = IIf(Len(tbl) = 0, t, tbl & vbTab & t)
            End If
        Next j%
        tbl = tbl & vbNewLine
        
    Next i%
 
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .Clear
        .SetText tbl
        .PutInClipboard
    End With
'
'
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2000, NumColumns:= _
        10, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
'        .Select
        If .Style <> "Сетка таблицы" Then
            .Style = "Сетка таблицы"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
        .Range.Paste
    Finish = Time()
    MsgBox Format(Finish - Start, "nn:ss")
    End With
 
End Sub