Option Explicit

Function Шапку_С_Таблицей_в_БД()
  
  ' Позволяет таблицы с отдельными шапками собирать в базу данных
  
  A2_2_Range _
    ArrayDim2_Set_ArrayDim2_Horizont_Right( _
    ArrayDim2_FillDown(ArrayDim2_Row_1, UBound(ArrayDim2_Rows)), _
    ArrayDim2_Rows), Лист1.Cells(2, 7)

End Function

Function ArrayDim2_Set_ArrayDim2_Horizont_Right( _
  a2_Left_() As Variant, _
  a2_Right() As Variant) _
  As Variant()
  ' test yes
  'массив приставить к массиву горизонтально справа

  Dim width_New As Long
  width_New = UBound(a2_Left_, 2) + UBound(a2_Right, 2)

  Dim a2_New() As Variant
  a2_New = a2_Left_

  ReDim Preserve a2_New(1 To UBound(a2_New), _
    1 To width_New)

  Dim lRow As Long, _
    lCol As Long, _
    diff_Column As Long
    
  diff_Column = LBound(a2_New, 2)
        
  For lRow = LBound(a2_New) To UBound(a2_New)
                    
    For lCol = UBound(a2_Left_, 2) + 1 To width_New
                    
      a2_New(lRow, lCol) = a2_Right( _
        lRow, lCol - diff_Column)
                    
    Next lCol
  Next lRow
                    
  ArrayDim2_Set_ArrayDim2_Horizont_Right = a2_New
          
End Function

Function ArrayDim2_Row_1() _
  As Variant()

  Dim a2() As Variant

  With Лист1

    a2 = .Range( _
      .Cells(2, 2), .Cells(4, 2)).Value

  End With
  
  ArrayDim2_Row_1 = ArrayDim2_Transpose(a2)
  
End Function

Function ArrayDim2_FillDown( _
  a2() As Variant, _
  rows_Max As Long) _
  As Variant()
  ' test yes
  ' однострочный массив протянуть вниз, _
  ' строку первую копировать в каждую

  Dim a2_New() As Variant
  ReDim a2_New(1 To rows_Max, 1 To UBound(a2))

  Dim lRow As Long, _
    lCol As Long
    
  For lRow = LBound(a2_New) To UBound(a2_New)
  
    For lCol = LBound(a2_New, 2) To UBound(a2_New, 2)
    
      a2_New(lRow, lCol) = a2(1, lCol)
    
    Next lCol
  Next lRow
  
  ArrayDim2_FillDown = a2_New
  
End Function

Function ArrayDim2_Rows() _
  As Variant()

  With Лист1
    
    ArrayDim2_Rows = .Range( _
      .Cells(7, 2), .Cells(16, 4)).Value
    
  End With
End Function

Function ArrayDim2_Transpose( _
  a2() As Variant) _
  As Variant()
  
  ' массив двумерный транспонирование
  
  Dim a2_Temp() As Variant, _
    x As Long, _
    y As Long
    
  ReDim a2_Temp( _
    LBound(a2, 2) To UBound(a2, 2), _
    LBound(a2, 1) To UBound(a2, 1))
    
  For x = LBound(a2, 2) To UBound(a2, 2)
        
    For y = LBound(a2, 1) To UBound(a2, 1)
            
      a2_Temp(x, y) = a2(y, x)
        
    Next y
  Next x
  
  ArrayDim2_Transpose = a2_Temp
  
End Function

Sub A2_2_Range( _
        a2() As Variant, _
        ceLL As Range)
    ' Test Covered
    ceLL.Resize( _
            UBound(a2), UBound(a2, 2)).Value = _
            a2

End Sub