Всем доброго здравия! Ребята, помогите мне изменить код! Забиваю данные в Лист1 и хочу, чтоб они автоматически улетали на соседние листы при любом изменении, без применения кнопки. Файл прилагается!
Всем доброго здравия! Ребята, помогите мне изменить код! Забиваю данные в Лист1 и хочу, чтоб они автоматически улетали на соседние листы при любом изменении, без применения кнопки. Файл прилагается!Кузьмич
Private Sub Worksheet_Change(ByVal Target As Range) With Application MCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False For Each Sheet In Worksheets If Not Sheet.Name = ActiveSheet.Name Then _ Sheet.Range(Target.Address) = Target Next .Calculation = MCalc .EnableEvents = True End With End Sub
[/vba]
Область ввода не определял и не проверял.
Если нужны данные только, то в модуль листа [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) With Application MCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False For Each Sheet In Worksheets If Not Sheet.Name = ActiveSheet.Name Then _ Sheet.Range(Target.Address) = Target Next .Calculation = MCalc .EnableEvents = True End With End Sub
Круто конечно, работает! Только все изменения на листе1 вне таблички если заполнять, копируются на все остальные, т.е есть заменяют нужные данные. А можно также, но с определенным диапазоном, предположим A7:I10?
Круто конечно, работает! Только все изменения на листе1 вне таблички если заполнять, копируются на все остальные, т.е есть заменяют нужные данные. А можно также, но с определенным диапазоном, предположим A7:I10?Кузьмич
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A7:I10")) Is Nothing Then With Application MCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False For Each cell In Intersect(Target, Range("A7:I10")) For Each Sheet In Worksheets If Not Sheet.Name = ActiveSheet.Name Then _ Sheet.Range(cell.Address) = cell Next Next .Calculation = MCalc .EnableEvents = True End With End If End Sub
[/vba]
Бонусом можно группу копировать
тогда [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A7:I10")) Is Nothing Then With Application MCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False For Each cell In Intersect(Target, Range("A7:I10")) For Each Sheet In Worksheets If Not Sheet.Name = ActiveSheet.Name Then _ Sheet.Range(cell.Address) = cell Next Next .Calculation = MCalc .EnableEvents = True End With End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
