Sub Сформировать()
    
    Dim shSrc As Worksheet, shRes As Worksheet
    Dim strVozrast As String
    Dim arr(), lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    Set shSrc = Worksheets("Регистр")
    lr = shSrc.Cells(shSrc.Rows.count, "A").End(xlUp).row
    arr() = shSrc.Range("A1:H" & lr).Value
    
    For i = 3 To UBound(arr)
        If arr(i, 3) <> "" Then
            strVozrast = arr(i, 3)
        Else
            strVozrast = arr(i, 4)
        End If
        For j = 5 To UBound(arr, 2)
            If arr(i, j) <> "" Then
                Set shRes = Worksheets(arr(2, j) & strVozrast)
                lr = shRes.Cells(shRes.Rows.count, "A").End(xlUp).row + 1
                shRes.Cells(lr, "A").Resize(, 2).Value = shSrc.Cells(i, "A").Resize(, 2).Value
            End If
        Next j
    Next i
    
    MsgBox "Готово!", vbInformation
    Application.ScreenUpdating = True

End Sub