Очень нужен макрос для таблицы

[Dorina]

Доброго времени суток! Очень нужна помощь!
Нужно преобразовать таблицу и записать ее в следующий лист(прикладываю картинки: Лист1 - исходная таблица, Лист2 - то, что надо получить), сложность в том, что таблица на самом деле большая, т.е. D1, D2, D3, D4, D5 и т.д., и столбцов U1-1, U2-1 и т.д. тоже много, и при этом надо будет обрабатывать таблицы с разным кол-вом этих столбцов.
Сижу второй день голову ломаю! Может кто подскажет! Заранее спасибо огромное!

[VictorM]

прикладываю картинки

лучше бы Вы файлик приложили.
Не обязательно всю таблицу, хватит десятка строк.
А здесь совсем непонятно, что, куда...

[Dorina]

Извиняюсь! Файл прикрепила, но он схематичный, строк может быть любое количество, и столбцов U1 и т.д. тоже каждый раз разное количество. Суть в том, что нужно: убрать столбцы с ФИО, адресом и т.д.; оставить столбец с № и все столбцы U, и в этих столбцах U1 и т.д. раскидать значения, которые идут через точку с запятой столбцом. Т.е. было

U1-1
1; 3; 6

Надо
U1-1
1
3
6

и перед 1, 3 и 6 сохранить соответствующий номер (т.е. D1).
Надеюсь понятно объяснила!

[R Dmitry]

Сообщение от Dorina

Извиняюсь! Файл прикрепила, но он схематичный, строк может быть любое количество, и столбцов U1 и т.д. тоже каждый раз разное количество. Суть в том, что нужно: убрать столбцы с ФИО, адресом и т.д.; оставить столбец с № и все столбцы U, и в этих столбцах U1 и т.д. раскидать значения, которые идут через точку с запятой столбцом. Т.е. было

U1-1
1; 3; 6

Надо
U1-1
1
3
6

и перед 1, 3 и 6 сохранить соответствующий номер (т.е. D1).
Надеюсь понятно объяснила!

нет понятней не стало, куда выгружать.....данные и что делать с остальными данными

[Dorina]

Остальные столбцы убрать, а выгрузить во второй лист.

[R Dmitry]

не уверен что правильно понял:

Sub test()
Dim arr(), arrF(), y, x&, a&, i&, j&
arr = Sheets("Лист1").[a1].CurrentRegion.Value '7
ReDim arrF(1 To 50000, 1 To UBound(arr, 2) - 5)
For i = 2 To UBound(arr)
  For j = 7 To UBound(arr, 2)
  arrF(1, j - 5) = arr(1, j)
        y = Split(arr(i, j), ";")
            For x = 0 To UBound(y)
                a = a + 1
                arrF(a + 1, 1) = arr(i, 1)
                arrF(a + 1, j - 5) = y(x)
            Next
   Next
Next
With Sheets("Лист2")
.[a1].Resize(a, UBound(arrF, 2)) = arrF
.Activate
End With
'Debug.Print UBound(arr, 2)
End Sub

сначала хотел рисунок кода сбросить

[nilem]

Ну, как вариант что ли. Зеленая стрелка.
Выходной массив ограничен на 10000 строк. Достаточно?

[R Dmitry]

добавил файл

[R Dmitry]

У нас разные варианты
я больше читал, ты больше смотрел
Кто из нас угадал ?

[nilem]

Сообщение от R Dmitry

У нас разные варианты
я больше читал, ты больше смотрел
Кто из нас угадал ?

Имеется в виду подсмотрел что ли? Зря Вы так.