Option Explicit
Private Sub CommandButton1_Click()
Dim nomer_stroki As Long, massiv() As Variant, i As Integer
nomer_stroki = ActiveCell.Row
massiv = Range(Cells(nomer_stroki, 1), Cells(nomer_stroki, 10))
With sh1
    For i = 1 To 10
        .Range("yacheyka_" & i) = massiv(1, i)
    Next
End With
End Sub

Option Explicit
Private Sub CommandButton1_Click()
Dim nomer_stroki As Long, massiv() As Variant, i As Integer, j As Integer
nomer_stroki = ActiveCell.Row
massiv = Range(Cells(nomer_stroki, 1), Cells(nomer_stroki, 10))

For j = 1 To 3
With Sheets("sh" & j)
    For i = 1 To 10
        .Range("yacheyka_" & i) = massiv(1, i)
    Next
'Next
End With
End Sub

Option Explicit
 '1. циклами по исходникам получаем словарь ключей петя|11,  коллекцию имён и  коллекцию дат.
'2. сортировка дат.
'3. выгрузка имён и дат на лист.
'4. циклами по листу собираем ключ, проверяем наличие в словаре, пишем (или нет) метку.
 
 
Sub tt()
    Dim a, i&, ii&, j&, col1 As New Collection, col2 As New Collection, ws As Worksheet, t$
    Dim vTemp As Variant
 
    Application.ScreenUpdating = False
 
    With CreateObject("Scripting.Dictionary"): .comparemode = 1
 
        On Error Resume Next
        a = [a1].CurrentRegion.Value
        '1
        For i = 1 To UBound(a, 2)
            a(i, 1) = Trim(a(i, 1))
            col1.Add a(i, 1), a(i, 1)
            For ii = 2 To UBound(a)
                If Len(a(i, ii)) = 0 Then Exit For
                col2.Add a(i, ii), Trim(a(i, ii))
                t = a(i, 1) & "|" & a(i, ii)
                .Item(t) = .Item(t) + 1
            Next
        Next
        On Error GoTo 0
 
        Set ws = Workbooks.Add.Sheets(1)
 
        '2
        'Two loops to bubble sort
        For i = 1 To col2.Count - 1
            For j = i + 1 To col2.Count
                If col2(i) > col2(j) Then
                    'store the lesser item
                    vTemp = col2(j)
                    'remove the lesser item
                    col2.Remove j
                    're-add the lesser item before the
                    'greater Item
                    col2.Add vTemp, Trim(vTemp), i
                End If
            Next j
        Next i
 
        '3
        For i = 1 To col1.Count
            ws.Cells(i + 1, 1) = col1(i)
        Next
 
        For i = 1 To col2.Count
            ws.Cells(1, i + 1) = col2(i)
        Next
 
        '4
        For i = 2 To col1.Count + 1
            For ii = 2 To col2.Count + 1
                t = ws.Cells(i, 1) & "|" & ws.Cells(1, ii)
                If .exists(t) Then ws.Cells(i, ii) = .Item(t)
            Next
        Next
    End With
 
    Application.ScreenUpdating = True
 
End Sub

Лист1.Cells(4, 3) = shToProcess.Cells(i, 1).Cells(i, 2)

Private Sub toForms()

If i < 4 Then i = GetI
For k = 1 To 16
    Range("Pol_" & k) = shToProcess.Cells(i, 1)
    Range("FIO_" & k) = shToProcess.Cells(i, 2)
    Range("Sex_" & k) = shToProcess.Cells(i, 3)
    Range("DR_" & k) = shToProcess.Cells(i, 4)
    Range("NP_" & k) = shToProcess.Cells(i, 5)
    Range("FIOVr_" & k) = shToProcess.Cells(i, 6)
    Range("Spec_" & k) = shToProcess.Cells(i, 7)
    Range("DPr_" & k) = shToProcess.Cells(i, 8)
    Range("KodU_" & k) = shToProcess.Cells(i, 9)
    Range("KodD_" & k) = shToProcess.Cells(i, 10)
    Range("Dop_" & k) = shToProcess.Cells(i, 11)
    Range("Zakl_" & k) = shToProcess.Cells(i, 12)
    Range("Not1_" & k) = shToProcess.Cells(i, 13)
    Range("Not2_" & k) = shToProcess.Cells(i, 14)
    Range("Not3_" & k) = shToProcess.Cells(i, 15)
Next k
End Sub