Vfrdtyky

I am trying to auto-copy rows from a master worksheet to a separate worksheet. This occurs when a specific value is entered into Column B in a Master sheet. E.g. if ABC is entered into Column B in Master, these rows will get auto-copied into a separate sheet called ABC.

The issue is I have other values I want to copy into other worksheets. E.g if DEF is entered in Column B in Master, then auto-copy into separate sheet called DEF. I dont know how to do this.

The code below automatically copies all rows when Change is entered into Column B. This works fine but I also want to add another function that copies all rows when 'Delay' is entered.

Sub FilterAndCopy()

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet



    Set sht1 = Worksheets("Master")

    Set sht2 = Worksheets("Change")



sht2.UsedRange.ClearContents



With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)

    .Cells.EntireColumn.Hidden = False ' unhide columns

    If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False



    .AutoFilter field:=1, Criteria1:="Change"



    .Range("A:F, BL:BO").Copy Destination:=sht2.Cells(4, "B")

    .Parent.AutoFilterMode = False



    .Range("H:BK").EntireColumn.Hidden = True ' hide columns

    End With

End Sub

That code just copies Change rows from the master sheet to change sheet.

However I want to add another function that copies Delay rows from the master sheet to delay sheet. I'm just not sure if this can be incorporated into the code above? Or if I can do the following:

Sub FilterAndCopy()

    Dim rng As Range, sht1 As Worksheet, sht3 As Worksheet



    Set sht1 = Worksheets("Master")

    Set sht3 = Worksheets("Delay")



sht3.UsedRange.ClearContents



With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)

    .Cells.EntireColumn.Hidden = False ' unhide columns

    If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False



    .AutoFilter field:=1, Criteria1:="Delay"



    .Range("A:B, BJ:BO").Copy Destination:=sht2.Cells(4, "B")

    .Parent.AutoFilterMode = False



    .Range("D:BI").EntireColumn.Hidden = True ' hide columns

    End With

End Sub

PLEASE NOTE:
This macro has to be triggered without running a script.

Back at it again.
Please note that this is tested and working so please double check before changing anything (like you did with B4 to B5 in the previous test).

Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False



    If Not Intersect(Target, Range("B:B")) Is Nothing Then



        Dim Sh1 As Worksheet: Set Sh1 = Me

        Dim Sh2 As Worksheet: Set Sh2 = Worksheets("CHANGE OF NO'S")

        Dim Sh3 As Worksheet: Set Sh3 = Worksheets("ECS")

        Dim R0 As Range

        Dim R1 As Range: Set R1 = Intersect(Sh1.UsedRange, Sh1.Columns(2))



        'Clear data in sheets

        Sh2.Cells.Clear

        Sh2.Range("B4") = "start"

        Sh3.Cells.Clear

        Sh3.Range("B4") = "start"



        'Clear autofilter

        If Sh1.AutoFilterMode Then Sh1.AutoFilterMode = False



        For Each R0 In R1

            Select Case Trim(R0.Value)

                Case Is = "Change"

                    Intersect(R0.EntireRow, Sh1.Range("A:F,BL:BO")).Copy Sh2.Cells(Sh2.Rows.Count, 2).End(xlUp).Offset(1, 0)

                Case Is = "Early"

                    Intersect(R0.EntireRow, Sh1.Range("A:D,O:R,BL:BO")).Copy Sh3.Cells(Sh3.Rows.Count, 2).End(xlUp).Offset(1, 0)

            End Select

        Next R0



        Sh2.Range("B4") = ""

        Sh3.Range("B4") = ""



    End If



Application.ScreenUpdating = True

End Sub

This is to be inserted on the "Master" sheet code or whatever you called it. See below:

Now the code will run when you type anything in column "B" in Master sheet. See below:

Sheet Master (Entering a new "Change" text in column "B"):

Updated sheets "CHANGE OF NO'S" and "ECS" :

May I suggest a slightly different approach :

Sub Copy_criteria()



    Dim Sh1 As Worksheet: Set Sh1 = Worksheets("SHIFT LOG")

    Dim Sh2 As Worksheet: Set Sh2 = Worksheets("CHANGE OF NO'S")

    Dim Sh3 As Worksheet: Set Sh3 = Worksheets("ECS")

    Dim R0 As Range

    Dim R1 As Range: Set R1 = Intersect(Sh1.UsedRange, Sh1.Columns(2))



    'Clear data in sheets

    Sh2.Cells.Clear

    Sh2.Range("B4") = "start"

    Sh3.Cells.Clear

    Sh3.Range("B4") = "start"



    'Clear autofilter

    If Sh1.AutoFilterMode Then Sh1.AutoFilterMode = False



    For Each R0 In R1

        Select Case Trim(R0.Value)

            Case Is = "Change"

                Intersect(R0.EntireRow, Sh1.Range("A:F,BL:BO")).Copy Sh2.Cells(Sh2.Rows.Count, 2).End(xlUp).Offset(1, 0)

            Case Is = "Early"

                Intersect(R0.EntireRow, Sh1.Range("A:D,O:R,BL:BO")).Copy Sh3.Cells(Sh3.Rows.Count, 2).End(xlUp).Offset(1, 0)

        End Select

    Next R0



    Sh2.Range("B4") = ""

    Sh3.Range("B4") = ""

End Sub