![]()
Sub test() Dim a, b, i As Long, ii As Long, n As Long a = Cells(1).CurrentRegion.Value ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3) For i = 1 To UBound(a, 1) For ii = 3 To UBound(a, 2) If a(i, ii) <> "" Then n = n + 1: b(n, 1) = a(i, 1) b(n, 2) = a(i, 2): b(n, 3) = a(i, ii) End If Next ii, i Sheets.Add.Cells(1).Resize(n, 3).Value = b End Sub
Bookmarks