Sub DeleteSpace()
Dim rCell As Range
    For Each rCell In Selection
        rCell = Trim(rCell)
        rCell = Replace(rCell, "  ", " ")
    Next
End Sub

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

Sheets("Дата начала").Select
For y = 1 To Cells.SpecialCells(xlLastCell).Row
    If Cells(y, 1) = "123" Then
        Exit For
    End If