Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Автоматический макрос без кнопки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматический макрос без кнопки (Макросы/Sub)
Автоматический макрос без кнопки
Кузьмич Дата: Понедельник, 12.03.2018, 19:19 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 61
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Всем доброго здравия!
Ребята, помогите мне изменить код! Забиваю данные в Лист1 и хочу, чтоб они автоматически улетали на соседние листы при любом изменении, без применения кнопки.
Файл прилагается!
К сообщению приложен файл: 9748325.xls(47.0 Kb)

Ну, теперь вся утка наша...
 
Ответить
СообщениеВсем доброго здравия!
Ребята, помогите мне изменить код! Забиваю данные в Лист1 и хочу, чтоб они автоматически улетали на соседние листы при любом изменении, без применения кнопки.
Файл прилагается!
Автор - Кузьмич
Дата добавления - 12.03.2018 в 19:19
bmv98rus Дата: Понедельник, 12.03.2018, 19:36 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1258
Репутация: 214 ±
Замечаний: 0% ±

Excel 2013/2016
Если нужны данные только, то в модуль листа
[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
[/vba]

Область ввода не определял и не проверял.


Сообщение отредактировал bmv98rus - Понедельник, 12.03.2018, 19:37
 
Ответить
СообщениеЕсли нужны данные только, то в модуль листа
[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
[/vba]

Область ввода не определял и не проверял.
Автор - bmv98rus
Дата добавления - 12.03.2018 в 19:36
Кузьмич Дата: Понедельник, 12.03.2018, 19:50 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 61
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Цитата bmv98rus, 12.03.2018 в 19:36, в сообщении № 2 ()
Область ввода не определял и не проверял.

Круто конечно, работает! Только все изменения на листе1 вне таблички если заполнять, копируются на все остальные, т.е есть заменяют нужные данные. А можно также, но с определенным диапазоном, предположим A7:I10?

Ну, теперь вся утка наша...
 
Ответить
Сообщение
Цитата bmv98rus, 12.03.2018 в 19:36, в сообщении № 2 ()
Область ввода не определял и не проверял.

Круто конечно, работает! Только все изменения на листе1 вне таблички если заполнять, копируются на все остальные, т.е есть заменяют нужные данные. А можно также, но с определенным диапазоном, предположим A7:I10?
Автор - Кузьмич
Дата добавления - 12.03.2018 в 19:50
bmv98rus Дата: Понедельник, 12.03.2018, 19:59 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1258
Репутация: 214 ±
Замечаний: 0% ±

Excel 2013/2016
тогда [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
[/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
[/vba]

Бонусом можно группу копировать
Автор - bmv98rus
Дата добавления - 12.03.2018 в 19:59
Кузьмич Дата: Понедельник, 12.03.2018, 20:04 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 61
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Цитата bmv98rus, 12.03.2018 в 19:59, в сообщении № 4 ()
тогда

То что нужно! Благодарю от души за помощь!!!

Ну, теперь вся утка наша...
 
Ответить
Сообщение
Цитата bmv98rus, 12.03.2018 в 19:59, в сообщении № 4 ()
тогда

То что нужно! Благодарю от души за помощь!!!
Автор - Кузьмич
Дата добавления - 12.03.2018 в 20:04
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматический макрос без кнопки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!