перенос строк с одного листа на другой по условию

[Irek11]

Здравствуйте Нужно строки (не пустые) с листа prn2 перенести на лист prn3 скопировав их,если возможно и по значению в колонке А в порядке возрастания. Важно скорость.Файл прилагается.Спасибо. Есть у меня решение, но по скорости решения меня не устраивает, чем больше строк в листе тем медленнее работает перенос. Если можно Макрос для решения подобной задачи.Спасибо.

[Hugo121]

Насчёт сортировки не понял.
Без сортировки быстро можно было бы так, если поудалять все ненужные пробелы в пустых с виду ячейках (на обоих листах):

Sub CopyData()
    Dim x As Range, r As Range
    Application.ScreenUpdating = False

    With Sheets("prn2")
        Set r = .Range(.[T4], .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set x = r.SpecialCells(xlCellTypeBlanks)(1)
    If Not x Is Nothing Then
        Set r = r.ColumnDifferences(x)
        With Sheets("prn3")
            r.Copy .Range("A" & .Rows.Count).End(xlUp)(2)
        End With
    End If

    Application.ScreenUpdating = True
End Sub

Пробелы можно и кодом удалить перед началом этого кода.
Но как работать с такими пробелами - я не нашёл быстрого варианта.
Разве что через массив, без форматов. Тогда можно и сотрировку массива перед выгрузкой сделать - но это много кода писать нужно...
Если делать копированием, то сортировку может быть можно добавить после выгрузки всему диапазону (или только выгруженному) или перед копированием источнику - сделать средствами Экселя, добавить в макрос.

[Irek11]

Привет не работает. This command will stop the debugder Set r = r.ColumnDifferences(x) Можно в файле прислать ответ

[kuklp]

Сообщение от Irek11

... по значению в колонке А в порядке возрастания. Важно скорость. ... Есть у меня решение, но по скорости решения меня не устраивает...

У Вас в примере в порядке убывания, Вы уж определитесь. И где же Ваше решение? Вижу только гору мусора в проекте ВБА.

[kuklp]

Сообщение от Hugo121

стоп, чуть не так, исправляю

Привет, Игорь. Я что-то пропустил? Вижу у Вас какой-то междусобойчик тут, файлов нет, а что-то обсуждаете:-)

[Hugo121]

Привет, Сергей.
Да я там на этих пробелах споткнулся...
Вот вариант в файле, пробелы на первом листе убрал, на втором не убирал.
Как сделать без массивов на неизменённом оригинальном файле - не знаю...
Разве что сперва кодом чистить...

[kuklp]

Понятно. Там по-любому надо в файле порядок наводить.

[nerv]

без сортировки, как понял

Sub io()
Sheets("prn2").Columns(1).SpecialCells(2, 1).EntireRow.Copy
Sheets("prn3").Range("A4").PasteSpecial Paste:=xlPasteValues
End Sub

[Hugo121]

Вот же - SpecialCells(2, 1)
А я там огород городил...
Тогда похоже так работает, без сортировки:

Sub io()
Set t = Sheets("prn3").Columns(1).SpecialCells(2, 1)
Set t = t.Offset(t.Rows.Count)(1)
Sheets("prn2").Columns(1).SpecialCells(2, 1).EntireRow.Copy t
End Sub

[Irek11]

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