ClearTxt+Перенос строк на лист2

[HelperAwM]

Здраствуйте программисты.
Нужна помощь в задачке удаление текста . перенос строки на лист2
Либо составить новый код либо исправить мой корявый
Исходный файл и Который должен получиться выложен в HelperAwM.rar
1)Перенести Строки начинающиеся с пустой ячеики в колонке 2 на Лист2
2)Полностью Удалить Строку С текстом "Дата" и Лист № , ОАО "Пример"

[Teslenko_EA]

Здравствуйте HelperAwM.
думаю решение Вашей задачи может быть выполнено подобным кодом

Sub Hello()
Dim i%, j%, v
With Sheets(1)
    i = WorksheetFunction.CountA(.[a:a])
    For j = i To 2 Step -1
        v = Cells(j, 2)
        If Len(v) = 0 Then
            v = WorksheetFunction.CountA(Sheets(2).[a:a]) + 1
            .Rows(j).Copy Sheets(2).Rows(v)
            .Rows(j).Delete
        ElseIf IsDate(v) Then
        Else
            .Rows(j).Delete
        End If

    Next
End With
End Sub

Евгений.

[SAS888]

1)Перенести Строки начинающиеся с пустой ячеики в колонке 2 на Лист2
2)Полностью Удалить Строку С текстом "Дата" и Лист № , ОАО "Пример"

Есть "куча" вариантов решения Вашей задачи. Но, если это возможно, то я всегда стараюсь не перебирать (сравнивать и т.п.) ячейки. Т.е. обойтись без циклов. Например, так:

Sub Main()
    Dim x As Range: On Error Resume Next
    [B:B].SpecialCells(2, 2).EntireRow.Delete
    Set x = [B:B].SpecialCells(4)
    x.EntireRow.Copy Sheets(2).[A1]: x.EntireRow.Delete
End Sub

Пример во вложении. Откройте файл и запустите макрос (при запуске макроса, активным должен быть 1-й лист).

[HelperAwM]

Круто Спасибо оба варианты отличные!!Супер, а работая с этои же программой вы незнаите как Чтобы 1 Строка с Датой Была сохранена и перенесена в ячейку (2,2) Как показано на рисунке Дата.JPEG Типа Усовершенствие программы ??

[SAS888]

Например, так (опять же, без цикла):

Sub Main()
    Dim x As Range, y As Range, i As Integer
    Application.ScreenUpdating = False: On Error Resume Next
    Set x = [B:B].Find("Дата", LookAt:=xlWhole)
    If Not x Is Nothing Then
        x.EntireRow.Copy: Rows(2).Insert: i = 3
    Else: i = 2
    End If
    Set y = Intersect(ActiveSheet.UsedRange, [B:B], Rows(i & ":" & Rows.Count))
    y.SpecialCells(2, 2).EntireRow.Delete: Set x = y.SpecialCells(4)
    x.EntireRow.Copy Sheets(2).[A1]: x.EntireRow.Delete
End Sub

Пример во вложении.

[HelperAwM]

Спасиба SAS888 а можешь добавить краткое описание какая строчка что делает?

[SAS888]

Да. Пожалуйста:

Sub Main()
'Объявляем тип переменных
    Dim x As Range, y As Range, i As Integer
    
'Запрещаем обновление экрана и игнорируем возможные ошибки.
'Это на случай, если не нашлось ни одной ячейки с текстом, либо ни одной пустой.
    Application.ScreenUpdating = False: On Error Resume Next
    
'Ищем в столбце "B" первое полное совпадение значения ячейки со словом "Дата"
    Set x = [B:B].Find("Дата", LookAt:=xlWhole)
    
'Если находим, то копируем эту строку и добавляем ее во 2-ю строку
'Именно добавляем. Метод "Cut/Paste" применять нельзя, т.к. 2-я строка исчезнет.
'А также, устанавливаем указатель i на строку 3

    If Not x Is Nothing Then
        x.EntireRow.Copy: Rows(2).Insert: i = 3
        
'Если не находим, то устанавливаем указатель i на строку 2
    Else: i = 2
    End If
    
'Определяем диапазон, как пересечение используемого диапазона листа, столбца "B" и строк
'с указателя i до последней строки листа.
'Т.е. получим диапазон y = столбец "B", начиная со строки i, заканчивая последней используемой строкой.
    Set y = Intersect(ActiveSheet.UsedRange, [B:B], Rows(i & ":" & Rows.Count))
    
'Удаляем строки, содержащие в диапазоне "y" текстовые константы.
    y.SpecialCells(2, 2).EntireRow.Delete
    
'Определяем диапазон "x" состоящий из пустых ячеек диапазона "y".
    Set x = y.SpecialCells(4)
    
'Копируем строки диапазона "x" и вставляем их во 2-й лист, начиная с ячейки "A1".
'Метод "Cut/Paste" применять нельзя, т.к. диапазон "x" несвязанный.
    x.EntireRow.Copy Sheets(2).[A1]: x.EntireRow.Delete
End Sub

ПРИМЕЧАНИЕ: у метода Find есть особенность. Например, если записать

Set x = [B:B].Find("Дата", LookAt:=xlWhole)

как в нашем примере, то поиск начнется со 2-й строки. И если искомое значение находится в 1-й строке, то для метода Find это является последним значением. Но т.к. мы в 1-й строке имеем цифры (я так понимаю, заголовки), то в данном случае это применимо.