Ни для кого не секрет, что Excel позволяет выделять только видимые строки. Например, если некоторые из них скрыты или к ним применен фильтр.

если кто-то не знает, как это сделать: выделяем диапазон - Alt+;(для английской раскладки);Alt+ж(для русской). Подробнее можно почитать в этой статье

Если после выделения только видимых ячеек их скопировать, то скопируются они как положено. Но при попытке вставить скопированное в отфильтрованный диапазон(либо содержащий скрытые строки) - результат вставки будет не совсем такой, как ожидалось. Данные будут вставлены даже в скрытые строки. Либо может появиться ошибка "Данная команда не применима к несвязанным диапазонам".
Решить стандартными функциями такую проблему нельзя, поэтому на помощь приходят "макросы"(коды, написанные на встроенном языке программирования Visual Basic for Application).

Копируем единый диапазон ячеек и вставляем только в видимые
Для решения проблемы нам по сути надо будет и копировать и вставлять ячейки кодом. Т.е. мы не будем использовать привычное копирование. Мы заменим его своей собственной процедурой копирования - макрос "My_Copy". А вставка будет макросом "My_Paste".
Итак, коды копирования и вставки:

Option Explicit
Dim rCopyRange As Range
'Этим макросом копируем данные
Sub My_Copy()
    If Selection.Count > 1 Then
        Set rCopyRange = Selection.SpecialCells(xlVisible)
    Else: Set rCopyRange = ActiveCell
    End If
End Sub
'Этим макросом вставляем данные, начиная с выделенной ячейки
Sub My_Paste()
    If rCopyRange Is Nothing Then Exit Sub
    If rCopyRange.Areas.Count > 1 Then MsgBox "Вставляемый диапазон не должен содержать более одной области!", vbCritical, "Неверный диапазон": Exit Sub
    Dim rCell As Range, li As Long, le As Long, lCount As Long, iCol As Integer, iCalculation As Integer
    Application.ScreenUpdating = False
    iCalculation = Application.Calculation: Application.Calculation = -4135
    For iCol = 1 To rCopyRange.Columns.Count
        li = 0: lCount = 0: le = iCol - 1
        For Each rCell In rCopyRange.Columns(iCol).Cells
            Do
                If ActiveCell.Offset(li, le).EntireColumn.Hidden = False And _
                   ActiveCell.Offset(li, le).EntireRow.Hidden = False Then
                    rCell.Copy ActiveCell.Offset(li, le)
                    lCount = lCount + 1
                End If
                li = li + 1
            Loop While lCount >= rCell.Row - rCopyRange.Cells(1).Row
        Next rCell
    Next iCol
    Application.ScreenUpdating = True: Application.Calculation = iCalculation
End Sub

Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, из Excel переходим в редактор VBA(Alt+F11) -Insert -Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt+F8 -выделяем имя макроса -Выполнить(Run).
Чтобы скопировать диапазон, надо выделить его и вызвать процедуру "My_Copy". Затем выделяем первую ячейку для вставки и вызываем код "My_Paste".
Но для большего удобства использования лучше назначить выполнение этих двух процедур("My_Copy" и "My_Paste") на горячие клавиши(в приведенных ниже кодах это делается автоматически при открытии книги с кодом). Для этого приведенные ниже коды необходимо просто скопировать в модуль ЭтаКнига(ThisWorkbook):

Option Explicit
'Отменяем назначение горячих клавиш перед закрытием книги
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^q": Application.OnKey "^w"
End Sub
'Назначаем горячие клавиши при открытии книги
Private Sub Workbook_Open()
    Application.OnKey "^q", "My_Copy": Application.OnKey "^w", "My_Paste"
End Sub

Тогда при каждом открытии книги с кодом сочетание клавиш Ctrl+q будет копировать выделенный диапазон ячеек, а сочетание клавиш Ctrl+w - вставлять скопированный диапазон, начиная с выделенной ячейки.

Если необходимо переносить только значения(т.е. если в ячейке будут формулы, то в итоге будет перенесен результат вычисления этой формулы), надо заменить строку в коде:

rCell.Copy ActiveCell.Offset(li, le)

на такую:

ActiveCell.Offset(li, le) = rCell.Value

Примечание: в коде выше копируется весь диапазон, даже если он содержит скрытые или отфильтрованные строки.

Скачать пример

  Tips_Macro_CopyPasteInHiddenRows.xls (46,5 КиБ, 15 550 скачиваний)

Копируем только видимые ячейки и вставляем только в видимые
По многочисленным просьбам доработал код. Данным кодом возможно копировать любые диапазоны: со скрытыми строками, скрытыми столбцами и вставлять скопированные ячейки также в любые диапазоны: со скрытыми строками, скрытыми столбцами. Работает совершенно так же, как и предыдущий: нажатием клавиш Ctrl+q копируем нужный диапазон(со скрытыми/отфильтрованными строками и столбцами или не скрытыми), а вставляем сочетанием клавиш Ctrl+w. Вставка производится так же в скрытые/отфильтрованные строки и столбцы или без скрытых.
Если в копируемом диапазоне присутствуют формулы, то во избежание смещения ссылок можно копировать только значения ячеек - т.е. при вставке значений будут вставлены не формулы, а результат их вычисления. Или если необходимо сохранить форматы ячеек, в которые происходит вставка - будут скопированы и вставлены только значения ячеек. Для этого надо заменить строку в коде(в файле ниже):

rCell.Copy rResCell.Offset(lr, lc)

на такую:

rResCell.Offset(lr, lc) = rCell.Value

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

Скачать пример:

  Tips_Macro_CopyPasteInHiddenCells.xls (54,5 КиБ, 14 527 скачиваний)

Так же см.:
Excel удаляет вместо отфильтрованных строк - все?! Как избежать
[MulTEx]Копировать только видимые ячейки

Loading

100 комментариев

  1. А как изменить данный макрос, что бы он не копировал видимый диапазон, а вырезал его?
    Пробовал заменить все "Copy" на "Cut", но увы.

    1. Александр, увы, но в данном случае простой замены мало. Cut работает чуть иначе. Поэтому Вам надо в коде сначала оставить все как есть, а в конце переноса данных(после Next iCol) добавить что-то вроде rCopyRange.Delete

  2. копирование и вставка значений несвязных ячеек (диапазонов)
    'Выделяете нужные ячейки на листе1, запускаете макрос - выбираете КУДА(destination) копировать - жмете ОК.
    Public Sub ValuesOfDisconnectedCells()
    Dim n&, c As Range, r As Range
    ReDim a(1 To Selection.Cells.Count)
    For Each c In Selection
    n = n + 1: a(n) = c.Value
    Next
    Set r = Application.InputBox("Select destination cells", Type:=8)
    If r.Cells.Count = n Then
    n = 0
    For Each c In r.Cells
    n = n + 1:c = a(n)
    Next
    End If
    End Sub

    1. Перед вставкой снимайте защиту(можно кодом - Selection.Parent.Unprotect "password"). Иначе не получится, т.к. используется метод SpecialCells, который невозможно использовать при активной защите листа.

  4. Это просто пеееееееесня!
    СПАСИБОЧКИ ВАМ, ДМИТРИЙ, БОЛЬШУЩЕЕ!!!!!! Два дня сидела и не могла понять - как сделать так, чтобы копировались только значения ячеек, а не формулы - все комментарии прочла, не понимала - а всё элементарно - НУЖНО ОСТАВИТЬ ТОЛЬКО ТУ СТРОЧКУ, КОТОРАЯ ВСТАВЛЯЕТ ЗНАЧЕНИЯ!!!! Господи, всего - то пару слов в статье, в самом конце - и решение проблемы вселенского масштаба!!!!!!!!!!!
    Спасибо Вам, большое! Успехов Вам и процветания Вам и Вашим близким!
    Храни Вас Бог!

  8. Подскажите пожалуйста, я ввела код этот, нажимаю на зеленый флажок, потом копирую нужный диапазон, а потом ставлю курсор на нужную ячейку и опять нажимаю зеленый флажок, чтобы вставилось, но выдает ошибку, почему?
    Может я как-то не так делаю?

    1. О каком флажке речь? Надо выделить диапазон для копирования и выполнить код "My_Copy". Далее выделить стартовую ячейку для вставки и выполнить код "My_Paste".
      Или назначить горячие клавиши для этих процедур - в статье написано как. И файл приложен, в котором это все уже сделано и работает.

  9. Добрый день. Делал все по инструкциям, благо написаны доходчиво, но ничего не получается. Excel зависает и вылетает при попытке вставить скопированные ячейки. Причем если вставлять в диапазон без скрытых ячеек, что можно делать и обычным способом, данные вставляются, но если есть хотя бы одна скрытая ячейка происходит зависание и вылет. Пример так же не работает появляется ошибка: "Microsoft Visual Basic - Run-time error ' 1004':
    Application-defined or dbject-defined error. Debug выделяет желтым следующие строки:
    " If ActiveCell.Offset(li, le).EntireColumn.Hidden = False And _
    ActiveCell.Offset(li, le).EntireRow.Hidden = False Then"
    Office 2016. Заранее спасибо за помощь.

    1. К сожалению, нечем помочь. Без конкретного примера файла причину поведения не угадать. Может быть дело и в самом офисе(какой-то сбой).
      А может быть выделяете полностью столбцы или строки и в какой-то момент Offset упирается в последнюю ячейку.

  10. К предыдущему посту. Перекачал еще раз пример, взял из него коды и все заработало. Так и не понял почему не работает при простом копировании и вставлении в модуль? В общем все получилось через файл примера. Большое спасибо!

Добавить комментарий

This site uses Akismet to reduce spam. Learn how your comment data is processed.