Copy data to two different sheets

[slcraig]

Good day the below code is what I am currently using. I am needing to figure out if there is a way to copy target area to two different sheets rather than just the one? Any help would be greatly appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Check to see only one cell updated
    If Target.CountLarge > 1 Then Exit Sub
    'Check to see if entry is made in column O after row 2 and is set to "Ordered"
    If Target.Column = 15 And Target.Row > 2 And Target.Value = "Ordered" Then
        Application.EnableEvents = False
        'Copy columns A to AA to order board sheet in next available row
        Range(Cells(Target.Row, "A"), Cells(Target.Row, "AA")).Copy Sheets("Order Board").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        'Delete current row after copied
        Rows(Target.Row).Delete
        Application.EnableEvents = True
    End If
End Sub

[p45cal]

Just add another line directly after:

Range(Cells(Target.Row, "A"), Cells(Target.Row, "AA")).Copy Sheets("Order Board").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

say (adjusted for your sheet name):

Range("A" & Target.Row & ":AA" & Target.Row).Copy Sheets("AnotherSheetSomewhere").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

or replace that original line that copies with:

With Range(Cells(Target.Row, "A"), Cells(Target.Row, "AA"))
   .Copy Sheets("Order Board").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
   .Copy Sheets("AnotherSheetSomewhere").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

[Paul_Hossler]

1. Welcome to the forum
2. Take a minute to read the FAQ at the link in my signature
3. I added CODE tags to your post, but you can add them using the [#] icon and paste any macros between

If I understand, you can try this. I changed a little because I try not to use long If.. And ...statements

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, r1 As Range    
    ' Check to see only one cell updated
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 15 Then Exit Sub
    If Target.Row < 3 Then Exit Sub
    If Target.Value <> "Ordered" Then Exit Sub
    Application.EnableEvents = False
    ' Copy columns A to AA to order board sheet in next available row
    Set r = Cells(Target.Row, 1).Resize(1, 27)    
    ' just in case the destination WS is blank
    Set r1 = Sheets("Order Board").Cells(Rows.Count, 1).End(xlUp)
    If Len(r1.Value) > 0 Then Set r1 = r1.Offset(1, 0)
    r.Copy r1
    Set r1 = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)
    If Len(r1.Value) > 0 Then Set r1 = r1.Offset(1, 0)
    r.Copy r1
    ' Delete current row after copied
    Rows(Target.Row).Delete    
    Application.EnableEvents = True
End Sub

[Dave]

or... if you want to skip using the clipboard with the copy/paste, I think you can use Paul's code and replace the copy line with this....

r1.Resize(r.Rows.Count, r.Columns.Count).Cells.Value = r.Cells.Value

HTH, Dave