CopyMemory crashes Excel application

Question

First, a little background.
I am trying to combine multiple 2D arrays. I usually scrolled through each element of a new array and added them to existing arrays or placed the values ​​of arrays on a separate sheet and created a new array from it, but I work with big data. I recently found the CopyMemory function and am excited about it, first tested it on simple pieces of data.

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Sub Test()
    Dim varr0(), varr1(), Border As Long
    varr0 = Application.Transpose(Range("a1").CurrentRegion.Value)
    Border = UBound(varr0, 2)
    varr1 = Application.Transpose(Range("a21").CurrentRegion.Value)
    ReDim Preserve varr0(1 To UBound(varr0, 1), 1 To UBound(varr0, 2) + UBound(varr1, 2))
    CopyMemory varr0(1, Border + 1), varr1(1, 1), UBound(varr1, 1) * UBound(varr1, 2) * 16
    Range(Cells(1, 10), Cells(1, 10).Offset(UBound(varr0, 2) - 1, UBound(varr0, 1) - 1)).Value = Application.Transpose(varr0)
End Sub

It is clear that this was a success (or so I thought), and I decided to work with pieces of my actual data, from there it went down.

Sub Test_2()
    Dim varr0(), varr1(), Border As Long, ws As Worksheet
    varr0 = Application.Transpose(ThisWorkbook.Worksheets("Sheet1").Range("a1").CurrentRegion.Value)
    Border = UBound(varr0, 2)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then
            varr1 = Application.Transpose(ws.Range("a1").CurrentRegion.Value)
            ReDim Preserve varr0(1 To UBound(varr0), 1 To UBound(varr0) + UBound(varr1))
            CopyMemory varr0(1, Border + 1), varr1(1, 1), UBound(varr1, 1) * UBound(varr1, 2) * 16
            Border = UBound(varr0, 2)
        End If
    Next
    ThisWorkbook.Worksheets("ws1").Range(Cells(1, 11), Cells(1, 11).Offset(UBound(varr0, 2) - 1, UBound(varr0, 1) - 1)).Value = Application.Transpose(varr0)
End Sub

, , Excel ( , , - ( cap)).
, , , . Per Variant 16 .

():

• ?
• Excel?
• • (, , )

:

, , .

Sub Test_6()
    Dim varr0(), varr1(), Border As Long, ws As Worksheet, MemUsage As Long
    varr0 = Application.Transpose(ThisWorkbook.Worksheets("Sheet1").Range("a1").CurrentRegion.Value)
    Border = UBound(varr0, 2)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then
            varr1 = Application.Transpose(ws.Range("a1").CurrentRegion.Value)
            ReDim Preserve varr0(1 To UBound(varr0, 1), 1 To UBound(varr0, 2) + UBound(varr1, 2))
            MemUsage = VarPtr(varr1(UBound(varr1, 1), UBound(varr1, 2))) - VarPtr(varr1(1, 1))
            CopyMemory varr0(1, Border + 1), varr1(1, 1), MemUsage + 16 + Len(varr1(UBound(varr1, 1), UBound(varr1, 2)))
            Border = UBound(varr0, 2)
        End If
    Next
    ThisWorkbook.Worksheets("Sheet1").Range(Cells(1, 11), Cells(1, 11).Offset(UBound(varr0, 2) - 1, UBound(varr0, 1) - 1)).Value = Application.Transpose(varr0)
End Sub

, , CopyMemory Excel .

Answer 1

, API , . , VBA API . VBA , .

, . , , .

Private Sub TestAppend()
    ' 17 Nov 2017

    Dim WsS As Worksheet, WsT As Worksheet          ' Source and Target
    Dim Arr() As Variant
    Dim Rl As Long                                  ' last row
    Dim i As Long

    Set WsS = ActiveSheet
    On Error Resume Next
    Set WsT = Worksheets("Temp")
    If Err Then
        Set WsT = Worksheets.Add(Sheet1)
        WsT.Name = "Temp"
    End If
    On Error GoTo 0

    ReDim Arr(1)
    Arr(0) = Range("A1").CurrentRegion.Value
    Arr(1) = Range("E1").CurrentRegion.Value

    For i = 0 To UBound(Arr)
        With WsT
            Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Cells(Rl, "A").Resize(UBound(Arr(i)), UBound(Arr(i), 2)).Value = Arr(i)
        End With
    Next i
End Sub