Макрос копирования и вставки по условию.

RSS

mikolaychik

Пользователь

Сообщений: 56 Регистрация: 12.11.2014

16.01.2020 02:15:17

Помогите пожалуйста с макросом.

Изначально я написал макрос – Корректировка Данных для переноса значения из строки - H5:N5, в ячейку – Р5.

Код

Sub КорректировкаДанных()    
    Selection.Copy    
    Range("P5").Select    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        
    :=False, Transpose:=False    
    Application.CutCopyMode = False    
    Run "Зеленый1"    
    Range("A1").Select
End Sub

Но в документе добавилось еще 2 строки: H8:N8 и H11:N11. Хотел для каждой писать отдельный макрос, но подумал, что можно их объединить через – Если, но моих знаний не хватает…

Пишу объяснительную:

1. Если активная ячейка находится в диапазоне - H5:N5, мы копируем данные активной ячейки и вставляем как значение в ячейку – Р5.

Отключаем выделение. Запускаем макрос - Зеленый1.

Активируем ячейку – А1. Все!!!

2. Если активная ячейка находится в диапазоне – H8:N8, мы копируем данные активной ячейки и вставляем как значение в ячейку – Р8.

Отключаем выделение. Запускаем макрос – Зеленый2.

Активируем ячейку – А1. Все!!!

3. Если активная ячейка находится в диапазоне – H11:N11, мы копируем данные активной ячейки и вставляем как значение в ячейку – Р11.

Отключаем выделение. Запускаем макрос – Зеленый3.

Активируем ячейку – А1. Все!!!

Прикрепленные файлы

Корректировка Данных.xlsm (19.51 КБ)

Изменено: mikolaychik - 16.01.2020 02:17:49

ocet p

Пользователь

Сообщений: 448 Регистрация: 24.03.2018

16.01.2020 04:29:51

? Это что-то подобное ?

Код

'модуль ThisWorkbook
Private Sub Workbook_Open()
    Sheets("Лист1").Select
    Range("A1").Select
End Sub

'модуль Лист1
Private Sub Worksheet_Activate()
    Sheets("Лист1").Select
    Range("A1").Select
End Sub

'модуль Лист1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target.Cells(1), Range("H5:N5,H8:N8,H11:N11")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        Range("P" & Target.Cells(1).Row).Value = Target.Cells(1).Value
        Select Case Target.Cells(1).Row
            Case 5: Call Зеленый1
            Case 8: Call Зеленый2
            Case 11: Call Зеленый3
            Case Else: Application.EnableEvents = True: Exit Sub
        End Select
        Range("A1").Select
    Application.EnableEvents = True
End Sub

mikolaychik Пользователь Сообщений: 56 Регистрация: 12.11.2014	#3 16.01.2020 20:13:53 Здравствуйте ocet p!!! Огромное Спасибо Вам за помощь!!! Хотел уже писать, что макрос не работает… Но потом все-таки положил макросы как Вы написали и все заработало!!! Это даже лучше чем я хотел!!! Еще раз Огромное Вам Спасибо!!!