Макрос для разбиения 1 столбца в несколько

[GuitaristNSK]

Доброго времени суток! Мне необходимо написать макрос, при выполнении которого добавлялось необходимое количество пустых столбцов. Затем другой столбец разбивался в созданные столбцы. В общем, принцип тот же, что и функция "Текст по столбцам". Только нужен именно макрос, т.к. количество столбцов может быть большим и вставлять целую кучу столбцов - не самый удобный вариант...очень надеюсь на чью-нибудь помощь. Заранее спасибо! В примере на Листе3 результат работы макроса.

[VictorM]

Ну так включите макрорекордер и проделайте все необходимые действия.
Получите практически готовый макрос.

[GuitaristNSK]

Спасибо за совет. Но все же он мне не помог окончательно решить проблему.
Получил я такой код:
Sub Макрос1()
'
' Макрос1 Макрос
'

'
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:A5").Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
End Sub
Мне не хватает автоматического поиска конца записей в книге. Т.е. если у меня в книге 5000 строк, то мне надо чтобы макрос сам определил номер последней строки . Начальная позиция всегда будет одна и та же.
В общем, в вот этом моменте
Range("A2:A5").Select
должно сохраниться А2:А(номер последней строки)

[VictorM]

Получите практически готовый макрос.

Макросы обычно нужно немного подредактировать, там много лишнего бывает и т.д.
Ваш макрос может выглядеть примерно так:

Sub Макрос1()

    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    Columns("B:B").EntireColumn.Insert
    Columns("B:B").EntireColumn.Insert
    Range("A2:A" & lRow).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
                                                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                                 Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                                                                                                          :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
                                                 TrailingMinusNumbers:=True
End Sub