Getting Macros to run automatically

[birdman15]

I am trying to get some macros to run automatically when a selection is made from a drop down list.
The change is when 'yes' is selected from the drop down in column D, the entire row is deleted from current sheet and moved to another.
I have 6 sheets total, with three different macros for this.
The goal is to have row from Sheet1 move to Sheet2 when drop down is selected to 'yes' (then same for Sheet3 to Sheet4 and Sheet5 to Sheet6)

I have the macros working right. When I select the drop downs to 'yes' on certain rows on each of the Sheet1, Sheet3 and Sheet5 and then manually run the macros from the menu one at a time, the rows do move to the correct places on the corresponding sheets.

However, I want these macros to run automatically as I make these drop down selections. I dont want to have to run each individual macro each time I make a selection. Can someone take a look at my code and tell me what I have wrong. Below is the info needed.

Sheet1 - "XB"
Sheet2 - "XBDistro"

Sheet3 - "Xumo"
Sheet4 - "XumoDistro"

Sheet5 - "Xi"
Sheet6 - "XiDistro"

Module1 Code:

Sub MoveToXBDistro()
        Dim xRg As Range
        Dim xCell As Range
        Dim A As Long
        Dim B As Long
        Dim C As Long
        A = Worksheets("XB").UsedRange.Rows.Count
        B = Worksheets("XBDistro").UsedRange.Rows.Count
        If B = 1 Then
            If Application.WorksheetFunction.CountA(Worksheets("XBDistro").UsedRange) = 0 Then B = 0
        End If
        Set xRg = Worksheets("XB").Range("D1:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False
        For C = 1 To xRg.Count
            If CStr(xRg(C).Value) = "yes" Then
                xRg(C).EntireRow.Copy Destination:=Worksheets("XBDistro").Range("A" & B + 1)
                xRg(C).EntireRow.Delete
                If CStr(xRg(C).Value) = "yes" Then
                    C = C - 1
                End If
                B = B + 1
            End If
    Next
    Application.ScreenUpdating = True
End Sub

Sub MoveToXumoDistro()
        Dim xRg As Range
        Dim xCell As Range
        Dim A As Long
        Dim B As Long
        Dim C As Long
        A = Worksheets("Xumo").UsedRange.Rows.Count
        B = Worksheets("XumoDistro").UsedRange.Rows.Count
        If B = 1 Then
            If Application.WorksheetFunction.CountA(Worksheets("XumoDistro").UsedRange) = 0 Then B = 0
        End If
        Set xRg = Worksheets("Xumo").Range("D1:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False
        For C = 1 To xRg.Count
            If CStr(xRg(C).Value) = "yes" Then
                xRg(C).EntireRow.Copy Destination:=Worksheets("XumoDistro").Range("A" & B + 1)
                xRg(C).EntireRow.Delete
                If CStr(xRg(C).Value) = "yes" Then
                    C = C - 1
                End If
                B = B + 1
            End If
    Next
    Application.ScreenUpdating = True
End Sub

Sub MoveToXiDistro()
        Dim xRg As Range
        Dim xCell As Range
        Dim A As Long
        Dim B As Long
        Dim C As Long
        A = Worksheets("Xi").UsedRange.Rows.Count
        B = Worksheets("XiDistro").UsedRange.Rows.Count
        If B = 1 Then
            If Application.WorksheetFunction.CountA(Worksheets("XiDistro").UsedRange) = 0 Then B = 0
        End If
        Set xRg = Worksheets("Xi").Range("D1:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False
        For C = 1 To xRg.Count
            If CStr(xRg(C).Value) = "yes" Then
                xRg(C).EntireRow.Copy Destination:=Worksheets("XiDistro").Range("A" & B + 1)
                xRg(C).EntireRow.Delete
                If CStr(xRg(C).Value) = "yes" Then
                    C = C - 1
                End If
                B = B + 1
            End If
    Next
    Application.ScreenUpdating = True
End Sub

Sheet1 Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
    Dim xVal As String
    On Error Resume Next
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Z = 1 To Target.Count
        If Target(Z).Value > 0 Then
            Call MoveToXBDistro
        End If
    Next
    Application.EnableEvents = True
End Sub

Sheet3 Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
    Dim xVal As String
    On Error Resume Next
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Z = 1 To Target.Count
        If Target(Z).Value > 0 Then
            Call MoveToXumoDistro
        End If
    Next
    Application.EnableEvents = True
End Sub

Sheet5 Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
    Dim xVal As String
    On Error Resume Next
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Z = 1 To Target.Count
        If Target(Z).Value > 0 Then
            Call MoveToXiDistro
        End If
    Next
    Application.EnableEvents = True
End Sub

I dont have code in any other sheet or "ThisWorkbook"
Is there anything I am missing or have in correct?
I just need them to automatically run as I make the selection in the drop downs.

Thanks!

 

[mumps]

Place these three event macros in the appropriate worksheet code modules. You don't need the other three "Move" macros.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "yes" Then
        With Target.EntireRow
            .Copy Sheets("XBDistro").Cells(Sheets("XBDistro").Rows.Count, "A").End(xlUp).Offset(1)
            .Delete
        End With
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "yes" Then
        With Target.EntireRow
            .Copy Sheets("XumoDistro").Cells(Sheets("XumoDistro").Rows.Count, "A").End(xlUp).Offset(1)
            .Delete
        End With
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "yes" Then
        With Target.EntireRow
            .Copy Sheets("XiDistro").Cells(Sheets("XiDistro").Rows.Count, "A").End(xlUp).Offset(1)
            .Delete
        End With
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[birdman15]

Place these three event macros in the appropriate worksheet code modules. You don't need the other three "Move" macros.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "yes" Then
        With Target.EntireRow
            .Copy Sheets("XBDistro").Cells(Sheets("XBDistro").Rows.Count, "A").End(xlUp).Offset(1)
            .Delete
        End With
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "yes" Then
        With Target.EntireRow
            .Copy Sheets("XumoDistro").Cells(Sheets("XumoDistro").Rows.Count, "A").End(xlUp).Offset(1)
            .Delete
        End With
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "yes" Then
        With Target.EntireRow
            .Copy Sheets("XiDistro").Cells(Sheets("XiDistro").Rows.Count, "A").End(xlUp).Offset(1)
            .Delete
        End With
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Worked like a charm. You're a life saver. I think I was just digging myself deeper and deeper and I tried myself lol. Thank you!

 

[mumps]

You are very welcome.