Страницы: 1
RSS
Как избежать копирования визуально пустых ячеек?
 
Здравствуйте, форумчане.
Опять к Вам на поклон. Проблема в следующем.
Макрос удаляет первую строку, выделяет от последней не пустой до А2 и выделенное копирует:
Workbooks("ДРУК.xlsm" ;) .Sheets("ФИЛЬТР" ;) .Activate
Rows("1:1" ;) .Delete
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(Cells(2, 1), Cells(LastRow, "bf" ;) ).Select
Selection.Copy

Проблема в том, что если не пустых от А2 и далее не окажется, заглавная строка удалится, как и должна, но будут выделяться пустые ячейки второй строки. А они потом копируются и тем же макросом вставляются в другую таблицу и искажают её данные.
Как сделать так, чтобы если в выделенных таким образом ячейках не будет текста и цифр (а формул не будет точно), т.е. ячейки окажутся визуально пустыми, макрос не копировал их?
Изменено: maseur - 25.01.2013 19:16:29
 
может что-то вроде этого
Код
Range("A2").Resize(Lrow).SpecialCells(xlCellTypeConstants).EntireRow.Copy Range("BG2")
 
Похоже, нашёл решение вопроса. Записал макрорекордером специальная вставка без пустых ячеек.
Вышеприведенный код прежний, а вот вставку поменял.
В имевшийся код вставил помеченное жирным:
ActiveCell.PasteSpecial Paste:=xlPasteAllAndValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:=False

При первых пробах замечаний нет.
 
Цитата
maseur пишет:
Вышеприведенный код прежний, а вот вставку поменял.
В имевшийся код вставил помеченное жирным
Смотрел с увеличительным стеклом, но в вышеприведенном коде слова Paste не увидел!
 
Цитата
При первых пробах замечаний нет.
Поспешил. В таком варианте и ячейки с данными не вставляет!!! Вопрос в силе.

То RAN, вот целый фрагмент, к которому претензии перечислены в первом сообщении темы:

  Workbooks("ДРУК.xlsm").Sheets("ФІЛЬТР").Activate
    Rows("1:1").Delete
                  LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   Range(Cells(1, 1), Cells(LastRow, "bf")).Select
       Selection.Copy
   Stop
   
   Workbooks("НЕ ДОПУЩЕНІ.xlsm").Sheets("НЕ ДОПУЩЕНІ").Activate
   ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Вопрос прежний.
 
Код
    Workbooks("ДРУК.xlsm").Sheets("ФІЛЬТР").Activate
    Rows("1:1").Delete
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Range(Cells(1, 1), Cells(LastRow, "bf")).Text = "" Or Range(Cells(1, 1), Cells(LastRow, "bf")).Text = "" <> Null Then
    Range(Cells(1, 1), Cells(LastRow, "bf")).Copy
    Workbooks("НЕ ДОПУЩЕНІ.xlsm").Sheets("НЕ ДОПУЩЕНІ").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                            xlNone, SkipBlanks:=False, Transpose:=False
    End If
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Большое спасибо, что отозвались, но, к сожалению не работает.
Не активируется
Workbooks("НЕ ДОПУЩЕНІ.xlsm")  .Sheets("НЕ ДОПУЩЕНІ")  .Activate

Это если ячейки не пустые.
Изменено: maseur - 25.01.2013 22:48:07
 
Тогда так:
Код
    Workbooks("ДРУК.xlsm").Sheets("ФІЛЬТР").Activate
    Rows("1:1").Delete
    Dim rFndRng As Range
    Set rFndRng = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not rFndRng Is Nothing Then
        LastRow = rFndRng.Row
        Range(Cells(1, 1), Cells(LastRow, "bf")).Copy
        Workbooks("НЕ ДОПУЩЕНІ.xlsm").Sheets("НЕ ДОПУЩЕНІ").Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                                xlNone, SkipBlanks:=False, Transpose:=False
    End If
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Класс!!! Помогло!!! Спасибо большое. Работает.

А где же Else?
 
А зачем Else? Вам же вроде бы надо было избавиться от копирования пустых. А не пустые копировать. Все так и происходит.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дошло. Спасибо большое.
Страницы: 1
Наверх