Помогите с макросом, пожалуйста.

[Dancerdi]

Доброго времени суток, помогите плиз с макросом, который объединяет столбцы в один, без потерь данных.
Самое близкое, что смог найти это макрос SAS888

Sub Main()
Dim i As Long, a(), b(): Application.ScreenUpdating = False
a = Range([A2], Cells(Cells(Rows.Count, 1).End(xlUp).Row, 4)).Value: ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1): b(i, 1) = "Тел.:" & a(i, 1) & ", Факс: " & a(i, 2) & ", E-mail:" & a(i, 3) & ", Сайт:" & a(i, 4): Next
Range([E2], Cells(UBound(b, 1) + 1, 5)).Value = b
End Sub

из этой темы http://www.programmersforum.ru/showthread.php?t=60113

но вот как переделать его под себя ума не приложу. Надо в столбец AY снести все данные из столбцов N - AX. Заранее спасибо

[IgorGO]

самое близкое, что смог написать:

Sub C14_50_2_51()
  Dim rg As Range, c As Long, r As Long
  r = 1:  c = 14:  Set rg = Cells(1, c)
  Do
    Do
      If rg.Cells(1) = "" Then Set rg = rg.Cells(1).End(xlDown)
      If rg.Cells(1) = "" Then
        If c >= 50 Then Exit Sub
        c = c + 1: Set rg = Cells(1, c)
      End If
    Loop Until rg.Cells(1) <> ""
    If rg.Cells(1).Offset(1, 0) <> "" Then Set rg = Range(rg, rg.Cells(1).End(xlDown))
    rg.Copy Cells(r, 51):  r = r + rg.Cells.Count
    If rg.Cells(rg.Cells.Count).Row < Rows.Count Then
      Set rg = rg.Cells(rg.Cells.Count).Offset(1, 0)
    Else
      If c < 50 Then c = c + 1: Set rg = Cells(1, c)
    End If
  Loop Until False
End Sub

[shanemac51]

для начала --привести в читабельный вид

Sub Main()
Dim i As Long, a(), b()
Application.ScreenUpdating = False
a = Range([A2], Cells(Cells(Rows.Count, 1).End(xlUp).Row, 4)).Value
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
  b(i, 1) = "Тел.:" & a(i, 1) & ", Факс: " & a(i, 2) _
  & ", E-mail:"   & a(i, 3) & ", Сайт:" & a(i, 4)
Next
Range([E2], Cells(UBound(b, 1) + 1, 5)).Value = b
Application.ScreenUpdating =TRUE
End Sub