работа с ячейкой, разделения текста по заданному разделителю, копирование в ниже стоящую ячейку.

[theoldmelnik]

Всем привет, есть проблема. Нужно написать скрипт на VBA для эксель который должен :

В каждой ячейке заданного столбца выделять текст до разделителя „;“ и вставлять его в новую строку этого же столбца. Так же в эту строку копировать данный с остальных столбцов например :
То что дано

Имя, фамилия, мэйл и профессия это столбцы
-------------------------------------------------------------------------------------------


Имя фамилия мэйл профессия
Вася пупкин мыло1 инженер;фотограф;парикмахер
Ксюша плюша мыло 2 сварщик;мантер;грузчик
-------------------------------------------------------------------------------------------

что должно получится
*число профессий не постоянно может быть 3 а может и 100 . так же как количество строк в документе
-------------------------------------------------------------------------------------------
Имя фамилия мэйл профессия
Вася пупкин мыло1 инженер
Вася пупкин мыло1 фотограф
Вася пупкин мыло1 парикмахер
Ксюша плюша мыло 2 сварщик;
Ксюша плюша мыло 2 мантер
Ксюша плюша мыло 2 грузчик
И прочее пока не кончится строки
-------------------------------------------------------------------------------------------


Буду очень благодарен за любую помощь , а то уже всю голову сломал себе.

Ах да Уровень владения VBA = 0,0000001

Спасибо и добра всем !

[alex77755]

копировать данный с остальных столбцов например

Не понятно:;фотограф;парикмахер в этой же ячейке? при чем столбцы?

[Казанский]

Расширенный режим, скрепка - приложите заархивированный образец файла "что есть" и "что надо". Чтобы не переделывать несколько раз.

[IgorGO]

выполните этот

Sub SplitProf()
  Dim r As Long, c As Long
  For r = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    c = UBound(Split(Cells(r, 4), ";"))
    If c > 0 Then
      Rows(r + 1).Resize(c).Insert shift:=xlDown
      Cells(r, 1).Resize(1, 3).Copy Cells(r + 1, 1).Resize(c, 1)
      Cells(r, 4).Resize(c + 1, 1).Value = WorksheetFunction.Transpose(Split(Cells(r, 4), ";"))
    End If
  Next
End Sub

при активном листе с Вашими данными

[theoldmelnik]

огромное вам спасибо ! это именно то что требовалось!
С радостью отблагодарил бы вас копеечкой но к сожелению не обладаю ниодной платежной системой кроме Paypal. если же у вас есть пэйпал то срадостью скажу спасибо в $ форме !