IF this is true (what i posted above), then enter the VBE screen,
in the right project screen, in the VBAProject of your MASTER workbook,
dbl-click on ThisWorkbook,
on the code screen, paste this code:
Private Const kBwb = "WorkBook_B"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Long
Dim wbA As Workbook, wbB As Workbook
Dim vAns
Dim sSht As String
Dim bIsRun As Boolean
'decision change
If Target.Column = 14 And Not bIsRun Then
bIsRun = True
If IsWbBOpen() Then
Set wbA = ActiveWorkbook
Set wbB = Workbooks(kBwb & ".xls")
r = ActiveCell.Row
vAns = UCase(ActiveCell.Value)
sSht = vAns & "_Sheet"
Range("B" & r & ":M" & r).Select
Selection.Copy
wbB.Activate 'B workbook
wbB.Sheets(sSht).Activate
Range("B3").Select
If ActiveCell.Offset(1, 0) <> "" Then Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select 'next empty cell
r = ActiveCell.Row
wbB.ActiveSheet.Paste 'paste
Application.CutCopyMode = False
'remove unwanted cells
Select Case vAns
Case "YES"
Range("E" & r).Value = ""
Range("G" & r).Value = ""
Case "NO"
Range("H" & r).Value = ""
Range("L" & r).Value = ""
Case "HOLD"
Range("H" & r).Value = ""
End Select
wbA.Activate
Else
MsgBox "B workbook is not open", vbCritical, "Missing workbook"
End If
bIsRun = False
Set wbA = Nothing
Set wbB = Nothing
End If
End Sub
Private Function IsWbBOpen() As Boolean
Dim wb As Workbook
Dim bFound As Boolean
For Each wb In Workbooks
If InStr(wb.Name, kBwb) > 0 Then
bFound = True
GoTo endit
End If
Next
endit:
IsWbBOpen = bFound
Set wb = Nothing
End Function
Bookmarks