Sub jjj()
Dim cl As Range, rng As Range, rngTmp As Range
Dim strDelim$, strTmp$
Dim Arr() As String
Dim i&, n&, j&, k&
 
    strDelim = InputBox("Введите символ-разделитель")
    If strDelim = "перенос" Then strDelim = Chr(10)
    If strDelim = "" Then End
     
    If TypeName(Selection) = "Range" Then
        Set rng = Selection
        n = rng.Rows.Count
        For i = n To 1 Step -1
            With rng(i, 1)
                strTmp = .Value & strDelim
                Arr = Split(strTmp, strDelim)
                j = UBound(Arr, 1) - 1
                If j > 0 Then
                    .Offset(1).Resize(j).EntireRow.Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
                    Set rngTmp = .Resize(j + 1)
                    For k = 0 To j
                        rngTmp(k + 1, 1).Value = Arr(k)
                    Next k
                End If
            End With
        Next i

SizeM = 12
 For i = 1 To SizeM 
 KONF(i) = Worksheets("Лист2").Range("A" & i + 1).Value
 CENA(i) = Val(InputBox("Введите стоймость-" & KONF(i) & " в рублях", "Ввод данных"))
 Cells(i + 1, 2) = CENA(i) 
 Next i

Private Sub CommandButton2_Click()
Dim maxCENA As Single
SizeM = 12
maxCENA = CENA(1)
Worksheets("Лист2").Select
Cells(1, 1) = "Вид конфет"
Cells(1, 2) = "Стоймость за 1кг"
For i = 1 To SizeM
Cells(i + 1, 1) = KONF(i)
Cells(i + 1, 2) = CENA(i)
Next i
For i = 1 To SizeM
If i = 1 Then
Worksheets("Лист2").Range("A" & i).Font.FontStyle = "Полужирный"
Worksheets("Лист2").Range("A" & i).HorizontalAlignment = xlCenter
Worksheets("Лист2").Range("B" & i).Font.FontStyle = "Полужирный"
Worksheets("Лист2").Range("B" & i).HorizontalAlignment = xlCenter
End If
Worksheets("Ëèñò2").Range("A" & i).Borders.LineStyle = xlContinuous
Worksheets("Ëèñò2").Range("B" & i).Borders.LineStyle = xlContinuous
If i > 1 Then
Worksheets("Ëèñò2").Range("B" & i).NumberFormat = "0.000"
End If
If CENA(i) > maxCENA Then
maxCENA = CENA(i): NomerMax = i
Next i
End Sub

Private Sub CommandButton2_Click()
Dim maxCENA As Single
Dim KONF(1 To 13) As String
Dim CENA(1 To 13) As Single
Dim SizeM, NomerMax, i, k As Integer
maxCENA = CENA(1)
Worksheets("Ëèñò2").Select
Cells(1, 1) = "Âèä êîíôåò"
Cells(1, 2) = "Ñòîéìîñòü çà 1êã"
For i = 1 To SizeM
Cells(i + 1, 1) = KONF(i)
Cells(i + 1, 2) = CENA(i)
Next i
For i = 1 To SizeM
If i = 1 Then
Worksheets("Ëèñò2").Range("A" & i).Font.FontStyle = "ïîëóæèðíûé"
Worksheets("Ëèñò2").Range("A" & i).HorizontalAlignment = xlCenter
Worksheets("Ëèñò2").Range("B" & i).Font.FontStyle = "ïîëóæèðíûé"
Worksheets("Ëèñò2").Range("B" & i).HorizontalAlignment = xlCenter
End If
Worksheets("Ëèñò2").Range("A" & i).Borders.LineStyle = xlContinuous
Worksheets("Ëèñò2").Range("B" & i).Borders.LineStyle = xlContinuous
If i > 1 Then
Worksheets("Ëèñò2").Range("B" & i).NumberFormat = "0.000"
End If
Next i
For i = 1 To SizeM
If CENA(i) > maxCENA Then
maxCENA = CENA(i): NomerMax = i
End If
Next i
End Sub