Это предполагает, что исходные данные находятся на Листе 1, а выходные данные будут размещены на Листе 2 .
Запуск этого короткого макроса:
Sub ReOrganizer() Dim N As Long, nCols As Long Dim i As Long, j As Long, k As Long Dim s1 As Worksheet, s2 As Worksheet Set s1 = Sheets("Sheet1") Set s2 = Sheets("Sheet2") N = s1.Cells(Rows.Count, 1).End(xlUp).Row nCols = 5 k = 2 For i = 2 To N Item = s1.Cells(i, 1) For j = 2 To nCols If s1.Cells(i, j) <> "" Then s2.Cells(k, 1) = Item s2.Cells(k, 2) = s1.Cells(i, j) k = k + 1 End If Next j Next i End Sub
будет принимать данные, как это в листе 1 :
и произвести это в Sheet2 :