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

[AChrist]

Здраствуйте!
Скажите пожалуйста, как с помощью макроса скопировать из одного листа непустые ячейки со второй столбца второй ячейки по последний столбец -> и вставить в другой лист все непустые ячейки НО в один столбец.

[IgorGO]

Sub CopyNoBlank()
  r = 1
  With Sheets(2)
    For Each c In Selection
      If c <> "" Then
        .Cells(r, 1) = c
        r = r + 1
      End If
    Next
  End With
End Sub

Предполагается перед началом выполнения этого кода отмечен диапазон с вашими данными.
Все будет скопировано на второй лист, в первую колонку. начиная с первого ряда.

[AChrist]

Раньше работал под 2003 офисом. Перешел на 2007, макрос выполняется, но значительно медленее. В чем может быть проблема? И как это можно оптимизировать при количестве копируемых ячеек больше 65000. Ну чтоб он сам переходил с первой колонки во вторую?

[EducatedFool]

Перешел на 2007, макрос выполняется, но значительно медленее

Видимо, перед запуском макроса Вы выделяете не диапазон ячеек, а столбцы (или строки) с этими ячейками...

В этом случае такой вариант макроса увеличит быстродействие:

Sub CopyNoBlank()
    On Error Resume Next
    r = 1
    With Sheets(2)
        For Each c In Intersect(Selection, ActiveSheet.UsedRange).Cells
            If c <> "" Then
                .Cells(r, 1) = c
                r = r + 1
            End If
        Next
    End With
End Sub

И как это можно оптимизировать при количестве копируемых ячеек больше 65000. Ну чтоб он сам переходил с первой колонки во вторую?

Надо полностью переделывать макрос.
Прикрепите к сообщению свой файл, подробно опишите, что и куда надо копировать.
(Файл желательно в формате 2003)

Для такого количества данных макрос обязательно надо тестировать, чтобы избежать тормозов.

[SAS888]

Посмотрите такой вариант. Предварительно выделять ничего не нужно. Диапазон с ячейки "B2" до последней используемой ячейки листа 1 "загоняется" в массив, затем все непустые значения "переформировываются" в другой массив, в котором количество строк в столбцах задается переменной "r" (в примере это 65536). После этого, массив размещается на лист 2. Т.к. все операции производятся в памяти компьютера (нет непосредственной работы с ячейками листа), то данный метод должен обладать максимальной производительностью. Проверьте.

Sub CopyNoEmpty()

    Dim i As Long, r As Long, a(), b(), c(), arr, v
    Sheets(1).Activate
    r = 65536 'Требуемое предельное количество строк в столбцах
    arr = Range([B2], Cells.SpecialCells(xlCellTypeLastCell)).Value
    ReDim b(1): i = 1
    For Each v In arr
        If v <> "" Then
            b(i) = v: ReDim Preserve b(UBound(b) + 1): i = i + 1
        End If
    Next
    ReDim c(1 To r, 1 To Fix((UBound(b) - 1) / r) + 1)
    For i = 1 To UBound(b)
        c(i - r * Fix((i - 1) / r), Fix((i - 1) / r) + 1) = b(i)
    Next
    Sheets(2).Activate: Cells.ClearContents
    Range([A1], Cells(UBound(c, 1), Fix((UBound(b) - 1) / r) + 1)).Value = c
    
End Sub