Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim KDB As Worksheet
  Set KDB = ThisWorkbook.Worksheets("Как должно быть")
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 With KDB
   For i = 2 To iLastRow Step 9
     iLR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
     .Cells(iLR, 1) = Cells(i, 1)               'идентификатор
     .Cells(iLR, 2) = Cells(i, 2)               'рабочее напряжение
     .Cells(iLR, 4) = Cells(i, 4)               '250 V
     .Cells(iLR, 5) = Cells(i + 1, 2)           'Макс.рабочее напряжение
     .Cells(iLR, 7) = Cells(i + 1, 4)           '250 V
     'и т.д.
   Next
 End With
End Sub

Sub mrshkei()
Dim arr, arr2, i As Long, n As Long, lr As Long, k As Long, k2 As Long, rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A1:E" & lr)
ReDim arr2(1 To lr, 1 To 3 * 40 + 1): k = 2
arr2(1, 1) = arr(1, 1)
For i = 2 To (3 * 40 + 1) Step 3
    arr2(1, i) = arr(1, 2)
    arr2(1, i + 1) = arr(1, 3)
    arr2(1, i + 2) = arr(1, 4)
Next i
For i = LBound(arr) + 1 To UBound(arr) Step 40
k2 = 2
arr2(k, 1) = arr(i, 1)
    For n = 0 To 8
        arr2(k, k2) = arr(i + n, 2)
        arr2(k, k2 + 1) = arr(i + n, 3)
        arr2(k, k2 + 2) = arr(i + n, 4)
        k2 = k2 + 3
    Next n
    k = k + 1
Next i
Set rng = Application.InputBox("Âûáåðèòå îäíó ÿ÷åéêó ñ êîòîðîé íà÷íåòñÿ âûâîä ðåçóëüòàòà", Type:=8)
rng.Resize(UBound(arr2), UBound(arr2, 2) - LBound(arr2) + 1) = arr2
End Sub

Sub mrshkei()
Dim arr, arr2, i As Long, n As Long, lr As Long, k As Long, k2 As Long, rng As Range
Dim col As New Collection
kol = 0
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A1:E" & lr)
For i = LBound(arr) + 1 To UBound(arr)
    On Error Resume Next
    col.Add arr(i, 1), CStr(arr(i, 1))
    xx = Application.WorksheetFunction.CountIf(Columns(1), arr(i, 1))
    If x < xx Then x = xx
Next i
ReDim arr2(1 To col.Count + 1, 1 To 3 * x + 1): k = 2
arr2(1, 1) = arr(1, 1)
For i = 2 To (3 * x + 1) Step 3
    arr2(1, i) = arr(1, 2)
    arr2(1, i + 1) = arr(1, 3)
    arr2(1, i + 2) = arr(1, 4)
Next i
For j = 1 To col.Count
xx = Application.WorksheetFunction.CountIf(Columns(1), col(j))
k2 = 2
For i = LBound(arr) + 1 To UBound(arr)
If col(j) = arr(i, 1) Then
arr2(k, 1) = arr(i, 1)
    For n = 0 To xx - 1
        arr2(k, k2) = arr(i + n, 2)
        arr2(k, k2 + 1) = arr(i + n, 3)
        arr2(k, k2 + 2) = arr(i + n, 4)
        k2 = k2 + 3
    Next n
Exit For
End If
Next i
k = k + 1
Next j
Set rng = Application.InputBox("Выберите одну ячейку с которой начнется вывод результата", Type:=8)
rng.Resize(UBound(arr2), UBound(arr2, 2) - LBound(arr2) + 1) = arr2
End Sub