Цель: вызвать два отдельных макроса worksheet_change(ByVal Target as Range)
для копирования данных и вставки в разные вкладки, когда:
- столбец J range = "Закрыто"; и
- диапазон столбца G редактируется любым способом.
VBA ниже, кажется, работает для (1). Но (2), по-видимому, запускает макрос, только когда данные ячейки столбца G удалены вместо input .
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
'Declare variables
Dim CompletionDate As String
Dim MsgGP As String
Dim TitleMsg As String
Dim CompletionComments As String
Dim MsgGP2 As String
Dim TitleMsg2 As String
Dim RevisedDate As String
Dim RevisedComments As String
Dim MsgGP3 As String
Dim TitleMsg3 As String
TitleMsg = "xx" 'Define InputBox text strings
MsgGP = "xx"
TitleMsg2 = "Road to $$"
MsgGP2 = "xx"
TitleMsg3 = "Task Deferral"
MsgGP3 = "Deferral due to:"
If Not Application.Intersect(target, Range("J" & ActiveCell.Row)) Is Nothing And InStr(1, Range("J" & ActiveCell.Row), "Closed") > 0 Then
'If column J has changed and equals closed
CompletionDate = Application.InputBox(MsgGP, TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1) 'Create Input box to enter completion date
If CompletionDate = "False" Then Exit Sub
CompletionComments = Application.InputBox(MsgGP2, TitleMsg2, Type:=0) 'Create Input box to enter completion comments
If CompletionComments = "False" Then Exit Sub
Sheets("Plan").Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).Copy 'Copy columns B to H
Sheets("Closed").Select 'Select other worksheet
Sheets("Closed").Range("i" & Rows.Count).End(xlUp).Offset(1) = CompletionDate 'Enter completion date
Sheets("Closed").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Paste work task data
Sheets("Closed").Range("j" & Rows.Count).End(xlUp).Offset(1) = CompletionComments 'Paste completion comments
Sheets("Plan").Activate 'Open Plan worksheet
Sheets("Plan").Range("D" & ActiveCell.Row & ":AV" & ActiveCell.Row).ClearContents 'Clear Contents in selected row
Sheets("Plan").Activate 'Open Plan worksheet
End If
If Not Intersect(target, target.Worksheet.Range("G" & ActiveCell.Row)) Is Nothing Then
RevisedComments = Application.InputBox(MsgGP3, TitleMsg3, Type:=0) 'Create Input box to enter completion comments
If RevisedComments = "False" Then Exit Sub
Sheets("Plan").Range("B" & ActiveCell.Row - 1 & ":H" & ActiveCell.Row - 1).Copy 'Copy columns B to H
Sheets("Revised").Select 'Select other worksheet
Sheets("Revised").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Paste work task data
Sheets("Revised").Range("j" & Rows.Count).End(xlUp).Offset(1) = RevisedComments 'Paste completion comments
Sheets("Plan").Activate 'Open Plan worksheet
End If
End Sub
Я уверен, что есть много полезных советов VBA по сокращению этого кода. Я был бы признателен, если бы вы могли передать эти советы вместе с потенциальным решением!