Страницы: 1
RSS
Автоматическое копирование данных исключая защищенные ячейки
 
Имеется две таблицы, абсолютно одинаковые по размеру и структуре. Множество ячеек каждой из таблиц защищены (вычисляемые или пустые). Защиту снимать нельзя.  
 
Необходимо скопировать данные из незащищенных ячеек одной таблицы в соответствующие незащищенные ячейки другой.  
 
Таблица достаточно большого размера, чтобы копировать по одной незащищенной ячейке вручную. (тем более таких пар таблиц несколько десятков).  
 
Подскажите, пожалуйста макрос, который бы копировал данные из одной таблицы в другую, исключая копирование из защищенных ячеек в соответственно защищенные.  
 
Предполагаю такой алгоритм:  
 
1. Выделяем диапазон в первой таблице.  
2. Нажимаем копировать.  
3. Переходим во второй файл.  
4. Определяем левый верхний угол таблицы для вставки (встаем).  
5. Запускаем макрос.  
6. Макрос определяет размер копируемой области  
7. Запускаем цикл. Слева направа, строка за строкой.  
8. Определяем защищена ли ячейка. Если защищена - идем дальше. Если нет, вставляем значение в соответствующую ячейку целевой таблицы.  
 
И т.д.  
 
Предполагаю, что команда "Копировать" может тут не подойти. Тогда может тоже надо через макрос сначала скопировать, а потом вставить.    
 
В общем, буду признателен за помощь!
 
пример
 
The_Prist  
Спасибо!  
 
Я сделал следующий файл (прилагаю). Он мне очень пригодился.  
 
А можно ли как то обратиться к буферу обмена, чтобы вставлять данные из него, пропуская защищенные ячейки!
 
И еще вопрос к предыдущему сообщению:  
Можно ли как-то создать на панели кнопку, которая бы выполняла определенный макрос, записанный не в файле, а в экселе?  
 
Ну т.е. чтобы не приходилось каждый раз файл с макросом открывать. А функция работала для любого открытого файла.
 
{quote}{login=dmention}{date=29.04.2010 02:14}{thema=}{post}И еще вопрос к предыдущему сообщению:  
Можно ли как-то создать на панели кнопку, которая бы выполняла определенный макрос, записанный не в файле, а в экселе?  
 
Ну т.е. чтобы не приходилось каждый раз файл с макросом открывать. А функция работала для любого открытого файла.{/post}{/quote}  
 
Функцию в надстройку или в PERSONAL.XLS. Туда же и макрос. Кнопку можно.
 
Я так понимаю, для этого необходимо создать настройку. Вам нужно смотреть информацию в этом направлении (подсказал бы как да где, но сам с надстройками пока не связывался...)
Audiatur et altera pars
 
А где найти файл personal.xls?
 
Создать такой файл, поместить туда функию. Файл поместить в каталог XLstart.
Я сам - дурнее всякого примера! ...
 
{quote}{login=}{date=11.05.2010 10:53}{thema=}{post}А где найти файл personal.xls?{/post}{/quote}  
Записываете мастером любой макрос (хоть просто выделить А1), как файл для макроса выбираете PERSONAL.XLS - фаыл создастся сам.
 
The_Prist, к сожалению выдает ошибку 13 рун тайм... ваша процедурка, на моменте    
Sheets(rCopyRange.Parent).Activate как подправить?
 
{quote}{login=The_Prist}{date=07.10.2010 03:13}{thema=}{post}К сожалению я ошибся при написании:  
 
rCopyRange.Parent.Activate{/post}{/quote}  
 
А вот теперь проблема, вот здесь    
If rCell.Locked = False Then rCell.Copy >>>>>Sheets(rPasteRange.Parent).Range(rCell.Address)<<<<<
 
{quote}{login=The_Prist}{date=07.10.2010 04:09}{thema=}{post}Ну Вы не видите, что проблема одна и та же? Подправить не в состоянии что ли? Всем готовенькое подавай. А как же зарядка для мозгов?! :-)  
 
rPasteRange.Parent.Range(rCell.Address){/post}{/quote}  
 
 
Ой, а что такое мозг??? опишите как оно работает, программно ))))))))))))))))))  
 
Короче пишет что не может копировать защищенные ячейки, а должен их пропускать... ошибка 1004 рун тайм... ячейка или диаграмма защищена от изменения...  
 
К сожалению макрос могу создать только через редактор...  
 
Sub Copy_Only_FreeCells()  
Dim rCopyRange As Range, rPasteRange As Range, rCell As Range  
On Error Resume Next: Application.DisplayAlerts = False  
Set rCopyRange = Application.InputBox("Âûáåðèòå äèàïçàîí äëÿ êîïèðîâàíèÿ", "Âûáîð äàííûõ", Type:=8)  
If rCopyRange Is Nothing Then MsgBox "Íå âûáðàí äèàïàçîí", vbCritical, "Îøèáêà": Exit Sub  
Set rPasteRange = Application.InputBox("Âûáåðèòå äèàïçàîí äëÿ âñòàâêè", "Âûáîð äàííûõ", Type:=8)  
If rPasteRange Is Nothing Then MsgBox "Íå âûáðàí äèàïàçîí", vbCritical, "Îøèáêà": Exit Sub  
On Error GoTo 0: Application.DisplayAlerts = True  
 
rCopyRange.Parent.Activate  
For Each rCell In rCopyRange  
If rCell.Locked = False Then rCell.Copy rPasteRange.Parent.Range(rCell.Address)  
Next rCell  
 
End Sub
 
сорриии  
 
Sub Copy_Only_FreeCells()  
Dim rCopyRange As Range, rPasteRange As Range, rCell As Range  
On Error Resume Next: Application.DisplayAlerts = False  
Set rCopyRange = Application.InputBox("Выберите диапзаон для копирования", "Выбор данных", Type:=8)  
If rCopyRange Is Nothing Then MsgBox "Не выбран диапазон", vbCritical, "Ошибка": Exit Sub  
Set rPasteRange = Application.InputBox("Выберите диапзаон для вставки", "Выбор данных", Type:=8)  
If rPasteRange Is Nothing Then MsgBox "Не выбран диапазон", vbCritical, "Ошибка": Exit Sub  
On Error GoTo 0: Application.DisplayAlerts = True  
 
rCopyRange.Parent.Activate  
For Each rCell In rCopyRange  
If rCell.Locked = False Then rCell.Copy rPasteRange.Parent.Range(rCell.Address)  
Next rCell  
 
End Sub
 
{quote}{login=The_Prist}{date=07.10.2010 05:57}{thema=}{post}На листе объединенных ячеек нет?{/post}{/quote}  
 
на самом листе есть, но в том диапазоне, который я копирую(вставляю), нет.
Страницы: 1
Наверх