Automatically populate more than one tab

[wlbamc]

Hi I am using the following code to automatically populate "LTC and CHC Panel Processes" tab when I complete the first tab, I also want this to automatically populate 2 other tabs, so 3 tabs in total when I complete the first 5 columns on the first tab any help gratefully received

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

With Application
  .EnableEvents = False
  .ScreenUpdating = False
End With
Select Case Target.Column
  Case Is = 1
    Target.Copy
       Sheets("LTC and CHC Panel Processes").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 2
    Target.Copy
       Sheets("LTC and CHC Panel Processes").Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 3
    Target.Copy
       Sheets("LTC and CHC Panel Processes").Range("C" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 4
    Target.Copy
       Sheets("LTC and CHC Panel Processes").Range("D" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 5
    Target.Copy
       Sheets("LTC and CHC Panel Processes").Range("E" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
  
       
Case Else
    '
       
End Select

With Application
  .EnableEvents = True
  .CutCopyMode = False
  .ScreenUpdating = True
End With
End Sub

 

[mumps]

What are the names of the other 2 sheets?

 

[wlbamc]

Discharge and transfer arrangem
Other measures

Thanks

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
If Target.CountLarge > 1 Then Exit Sub

With Application
  .EnableEvents = False
  .ScreenUpdating = False
End With
   If Intersect(Target, Range("A:E")) Is Nothing Then Exit Sub
   For Each ws In Sheets(Array("LTC and CHC Panel Processes", "Discharge and transfer arrangem", "Other measures"))
      ws.Cells(Rows.Count, Target.Column).End(xlUp)(2).Value = Target.Value
   Next ws
   Target.Offset(, 1).Select

With Application
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:E")) Is Nothing Then Exit Sub
    Dim ws As Worksheet
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With Application
      .EnableEvents = False
      .ScreenUpdating = False
    End With
    For Each ws In Sheets(Array("LTC and CHC Panel Processes", "Discharge", "transfer arrangem"))
        ws.Cells(ws.Rows.Count, Target.Column).End(xlUp).Offset(1, 0) = Target
    Next ws
    With Application
      .EnableEvents = True
      .CutCopyMode = False
      .ScreenUpdating = True
    End With
End Sub

It looks like Fluff beat me to it!!

 

[wlbamc]

Thank you both, works a treat

 

[Fluff]

Glad we could help & thanks for the feedback

 

[wlbamc]

Hi I have put the code in which works perfectly for the first line but doesn't seem to work for any of the other lines on the sheet, any ideas please

 

[Fluff]

Do you mean it only works if you change a value on row1?

 

[wlbamc]

Yes nothing happens when I input on row 2 down