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

[Irek11]

Здравствуйте. Не могу понять как написать макрос на копирование значений с одного листа на другой по условию. Файл прилагается.Помогите.

[Hugo121]

Способ небыстрый, но интересный, хотя конечно годится не для всех случаев:

Sub tt()
    Dim cc, i&
    For Each cc In Sheets("prn2").[a4:an1004].SpecialCells(xlCellTypeFormulas)
        If Len(Trim(cc.Value)) Then
            i = i + 1
            Sheets("prn3").[a20:an1024].Item(i) = cc.Value
        End If
    Next
End Sub

Вместо [a20:an1024] можете [a1:an1004] указать - я просто затирать пример не хотел.
Если бы формулы не возвращали пробел - можно было бы чуть иначе и быстрее код написать.
Хотя конечно и так можно иначе и быстрее..

[Irek11]

Копирование данных и перенос, осуществляется не строго в как хотелось бы, смешивая данные в колонках. Файл с описанием прикреплен.

[Irek11]

файл для просмотра.

[Hugo121]

Ну надо было сразу такой пример показать - код был бы другой.
Посмотрите такой вариант (i = 36 замените на своё значение):

Sub tt()
    Dim cc As Range, i&, a()
    Application.ScreenUpdating = False
    i = 36
    For Each cc In Sheets("pbs2").[a4:a2006].Cells
        If Len(Trim(cc.Value)) Then
            i = i + 1
            a = cc.Resize(, 20).Value
            With Sheets("pbs3").Cells(i, 1).Resize(, 20)
                .Value = a
                .Borders.Weight = xlThin
            End With
        End If
    Next
    i = 36
    For Each cc In Sheets("pbs2").[u4:u2006].Cells
        If Len(Trim(cc.Value)) Then
            i = i + 1
            a = cc.Resize(, 20).Value
            With Sheets("pbs3").Cells(i, 21).Resize(, 20)
                .Value = a
                .Borders.Weight = xlThin
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[Irek11]

Спасибо Вам Hugo121 вариант работает