Odtnhj

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