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