This has been modified to to copy only columns B thru J of each row that
meets the criteria and to begin pasting at B6 on the receiving sheet.
However, I do not understand the part about overwriting the data each time.
If you do that then the copy exercise appears to be useless. Perhaps if you
explained more about how you are using the data that is copied, a better
solution could be worked out. If so, start a new thread when you post so we
don't have to keep searching for this one.


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Sheets("Donnees")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
lr = ws1.Cells(Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
For Each c In rng
If c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws2.Cells(Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr2 + 1)
ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws2.Cells(Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr2 + 1)
ElseIf c.Value = 10 And _
UCase(Range("v" & c.Row).Value) = "X" Then
lr3 = ws3.Cells(Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr3 + 1)
End If
Next
ThisWorkbook.Save
ThisWorkbook.Close
End Sub


"LiAD" wrote in message
...
Yeah it was in the right place I'd changed the position of one of the
cells
and not updated the code - sorry.

There are two items which I would like to change if possible. Sorry these
were not in the original description.

1 - When the conditions are met I only want to copy from cols B9 to Jxx of
Données, not the entire row.

2 - I want to paste into cell B6 of each worksheet every time, not start
at
the last row. Therefore each time it gets closed the macro will overwrite
what was previously there, not add it onto the bottom.

Is it possible to change the macro to do these two things?

Thanks

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Sheets("Données")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
lr = ws1.Cells(Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
For Each c In rng
If c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws2.Cells(Rows.Count, 9).End(xlUp).Row
c.EntireRow.Copy ws2.Range("A" & lr2 + 1)
ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws2.Cells(Rows.Count, 9).End(xlUp).Row
c.EntireRow.Copy ws2.Range("A" & lr2 + 1)
ElseIf c.Value = 10 And _
UCase(Range("v" & c.Row).Value) = "X" Then
lr3 = ws3.Cells(Rows.Count, 9).End(xlUp).Row
c.EntireRow.Copy ws3.Range("A" & lr3 + 1)
End If
Next
ThisWorkbook.Save
ThisWorkbook.Close
End Sub



"JLGWhiz" wrote:

Using the data in your posting I built a model and named two of the
sheets
using the names that were specified in the posting. Since no name was
supplied for the sheet to be copied from, it was designated as
ActiveSheet.
numbers were then randomly entered in column J of the ActiveSheet in
values
of 2,4,6,8 and 10. In Column U several cells were populated with "X"
and
some were left blank to create a realistic condition. When the workbook
was
closed, it copied the cells which met the criteria from the ActiveSheet
to
their respective named sheets.

Check you sheet names for spelling errors. Subtitute the actual name of
the
sheet containing the data to be copied where ActiveSheet appears in the
code. Be sure you have put the code into the "ThisWorkbbok" code
module.
To access the code module, press Alt + F11 and then double click on
"ThisWorkbook" in the small projects window located in the upper left of
the
VBE window.

It tested OK, so I don't know what else to tell you.



"LiAD" wrote in message
...
Hi,

Thanks a lot for your help.

I have tried the macro but it doesnt seem to do anything - as in
nothing
changes when i close the file. If i put a stop line near the beginning
of
the code it doesnt show up so i guess this means its not running it.
Is
there something I need to do?

In terms of the length of data, sorry maybe i hadnt specified it but I
had
though that it would just write over the top of the old data. Will
this
code
do this or add the same data on below the current?

"JLGWhiz" wrote:

Give this a try. Copy the code to the ThisWorkbook code module. When
the
user closes the workbook, the code will run before the workbook closes
and
will save the data that was copied. The only problem I see with doing
it
this way is that it copies every time the workbook is closed, so the
worksheets receiving the data will build up pretty fast unless you
have
some
kind of system to review them and eliminate redundant data.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = ActiveSheet
Set ws2 = Sheets("Imperatifs")
Set ws3 = Sheets("Urgencies")
lr = ws1.Cells(Rows.Count, "J").End(xlUp).Row
Set rng = ws1.Range("J2:J" & lr)
For Each c In rng
If c.Value = 4 And UCase(Range("U" & c.Row).Value) = "X" Then
lr2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
c.EntireRow.Copy ws2.Range("A" & lr2 + 1)
ElseIf c.Value = 6 And UCase(Range("U" & c.Row).Value) = "X"
Then
lr2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
c.EntireRow.Copy ws2.Range("A" & lr2 + 1)
ElseIf c.Value = 10 And _
UCase(Range("U" & c.Row).Value) = "X" Then
lr3 = ws3.Cells(Rows.Count, 2).End(xlUp).Row
c.EntireRow.Copy ws3.Range("A" & lr3 + 1)
End If
Next
ThisWorkbook.Save
ThisWorkbook.Close
End Sub


"LiAD" wrote in message
...
Hi,

Is it possible to have a copy paste macro that runs in the
background,
as
in
the user does not need to push a button or do anything? I guess to
avoid
the
macro constantly updating when the user is in the file it would be
best
if
the macro ran when closing the file.

I have a table with names, dates etc in it going from col B to U.
In
col
J
I have the a ranking values which is either 2,4,6,8 or 10. In U I
have
an
X
if its an interesting item or not ( it filters whether certain
actions
have
been completed etc).

I would like a macro that takes all of the items with a 10 in col J
AND
an
X
in col U and put them into an adjacent sheet named Urgences. Items
with
either a 4 AND an X or a 6 AND an X go into a sheet named
Imperatifs.

Is this sort of automatic filter/copy/paste on closing macro
possible?

Thanks
LiAD