Имеем множество ячеек с данными. Все они в столбце А.
Необходимо в ячейке А1 оставить первые 4 значения, остальное перенести в ячейку B1.
Ячейку A2 перенести в ячейку C1.
Повторить для всех остальных.
Наглядно вот так:
Было: A1=3637 Тема обсуждения. A2=В процессе
Должно стать: A1=3637 B1=Тема обсуждения. C1=В процессе
Изменения требуется вносить в каждую пару строк до конца документа.
[вложение удалено администратором]
Вверх модуля вставьте эти строки:
Option Explicit
Option Compare Text
Option Base 1
Макрос
Sub Макрос()
Dim src(), res()
Dim lr As Long, r As Long, i As Long
'1. Копируем данные из столбца A в массив "src". С массивом макрос быстрее работает,
' чем с эксель-ячейками.
' End не ищет в скрытых строках.
lr = Cells(Rows.Count, "A").End(xlUp).Row
src() = Range("A1:A" & lr).Value
'2. Создание ячеек в массиве "res". Сначала в него запишем данные, а затем
' массив вставим на лист. Это быстрее, чем писать данные в эксель-ячейки.
ReDim res(UBound(src), 3)
'3. Копирование данных из массива "src" в массив "res".
For i = 1 To UBound(src) Step 2
' Переходим на следующую строку в массиве "res".
r = r + 1
' Копирование данных из массива "src" в массив "res".
res(r, 1) = Left(src(i, 1), 4)
res(r, 2) = LTrim(Mid(src(i, 1), 5))
res(r, 3) = src(i + 1, 1)
Next i
'4. Вставка массива "res" на лист.
Range("A1").Resize(UBound(res, 1), UBound(res, 2)).Value = res()
'5. Сообщение.
MsgBox "Готово.", vbInformation
End Sub