Нужно по крайней ячейке разделить строку на две и скопировать содержимое. Исходный файл с парой тысяч записей, возможно ли это сделать? Пример во вложении. Дано: лист1 Необходимо: лист2
Sub Razdel_FIO()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
Dim arr
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
If InStr(1, Cells(i, "D"), Chr(10)) <> 0 Then
arr = Split(Cells(i, "D"), Chr(10))
For n = UBound(arr) To 0 Step -1
If arr(n) <> "" Then
Rows(i + 1).Insert
Cells(i + 1, "D") = arr(n)
Range("A" & i & ":C" & i).Copy Range("A" & i + 1)
End If
Next
Rows(i).Delete
End If
Next
End Sub