Добрый День! Есть у нас большой график с множеством фильтров, один из фильтров исполнитель, их 5 шт. каждый исполнитель заполняет за себя сам. Но вот возникла необходимость объединить график в один. и о чудо, он не даёт копировать ячейки с заполненными данными ( просто цифры, без формул). пробовал вот такой вот макрос:
Код
Sub PasteToVisible() Dim copyrng As Range, pasterng As Range
Dim cell As Range, i As Long
'запрашиваем у пользователя по очереди диапазоны копирования и вставки
Set copyrng = Application.InputBox("Диапазон копирования", "Запрос", Type:=8)
Set pasterng = Application.InputBox("Диапазон вставки", "Запрос", Type:=8)
'проверяем, чтобы они были одинакового размера
If pasterng.SpecialCells(xlCellTypeVisible).Cells.Count <> copyrng.Cells.Count Then
MsgBox "Диапазоны копирования и вставки разного размера!",vbCritical
Exit Sub
End If
'переносим данные из одного диапазона в другой только в видимые ячейки
i = 1
For Each cell In pasterng
If cell.EntireRow.Hidden = False Then
cell.Value = copyrng.Cells(i).Value
i = i + 1
End If
Next cell
End Sub
Да да В этом макросе сравнение идет не по выбранным диапазонам. В диапазоне вставки учитываются только видимые ячейки поэтому у вас не получается. Просто этот макрос написан для конкретного задания. И для того чтобы вам помогли надо файл пример и пояснения откуда куда скопировать
Sub PasteToVisible(): Dim copyrng As Range, pasterng As Range
Dim cell As Range, i As Long
'запрашиваем у пользователя по очереди диапазоны копирования и вставки
Set copyrng = Application.InputBox("Диапазон копирования", "Запрос", Type:=8)
Set pasterng = Application.InputBox("Диапазон вставки", "Запрос", Type:=8)
'проверяем, чтобы они были одинакового размера
If pasterng.SpecialCells(xlCellTypeVisible).Cells.Count <> copyrng.SpecialCells(xlCellTypeVisible).Cells.Count Then
MsgBox "Диапазоны копирования и вставки разного размера!", vbCritical
Exit Sub
End If
'переносим данные из одного диапазона в другой только в видимые ячейки
i = 1
For Each cell In pasterng
If cell.EntireRow.Hidden = False Then
cell.Value = copyrng.Cells(i).Value
i = i + 1
End If
Next cell
End Sub
Вам Ігор Гончаренко, написал не ячейки, а диапазон, например у Вас в копируемом диапазоне выделено 2 ячейки и в диапазоне в который вставляете должно быть выделено 2 ячейки. И Вам не плохо было бы почитать правила форума и приложить файл с примером.