В общем посмотрел, что для редизайнера тут нужно еще править... ловите готовый макрос для Ваших данных [vba]
Код
Sub k() Dim m(), m1(), i&, ii&, r&, c& m = Sheets(1).[g1:z3].Value ' сюда адрес, который нужно просматривать ReDim m1(1 To UBound(m) * 2 * Int(UBound(m, 2) / 4), 1 To 4) 'r = 1 For ii = 1 To Int(UBound(m, 2) / 4) For i = 1 To UBound(m) c = ii * 4 - 3 If Len(m(i, c + 3)) = 0 Then Exit For r = r + 1 m1(r, 1) = m(i, c) m1(r, 2) = m(i, c + 1) m1(r, 3) = m(i, c + 2) m1(r, 4) = m(i, c + 3) Next r = r + 1 Next Sheets(2).[a1].Resize(r, 4) = m1 ' по умолчанию выгружаю на 2-й лист End Sub
[/vba]
В общем посмотрел, что для редизайнера тут нужно еще править... ловите готовый макрос для Ваших данных [vba]
Код
Sub k() Dim m(), m1(), i&, ii&, r&, c& m = Sheets(1).[g1:z3].Value ' сюда адрес, который нужно просматривать ReDim m1(1 To UBound(m) * 2 * Int(UBound(m, 2) / 4), 1 To 4) 'r = 1 For ii = 1 To Int(UBound(m, 2) / 4) For i = 1 To UBound(m) c = ii * 4 - 3 If Len(m(i, c + 3)) = 0 Then Exit For r = r + 1 m1(r, 1) = m(i, c) m1(r, 2) = m(i, c + 1) m1(r, 3) = m(i, c + 2) m1(r, 4) = m(i, c + 3) Next r = r + 1 Next Sheets(2).[a1].Resize(r, 4) = m1 ' по умолчанию выгружаю на 2-й лист End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
