Copy code - JLGWhiz

[LiAD]

Hi,

I have the following code (from JLGWhiz) which based on the value in the K
col. plus whether it has a X in the V col. copies the data into one of the
prenamed worksheets.

However if I open the file and update it, close it then open it and close it
again without touching anything I will have double info. It will copy into
rows 6-9 or whatever then the second time it will copy exactly the same data
into rows 10-13. So if I in my Données sheet I have 10 items and assume 4 of
these I need to copy to the Urgences sheet then if I open and close the file
twice as I suggested I will have 8 entries in it, I need only four, no
doubles. If the code overwrites all the data saved in the other sheets
(Imperatifs, Urgences) every time it closes, always copying into row 6 then
it would avoid double entries.

Also I cols C, D and F in the Données sheet the user enters their data from
drop down lists (validation lists). When the macro runs it asks me multiple
times if I want to use the same name in the sheet I copy to – I don’t, I just
want the values.

Two questions

How can I change the code to copy from Données to the correct sheet, only
starting in row 6 EVERY TIME?
How can I disable the question asking wether I want to use the names? (or
have an auto input to say yes by default)

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
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

 

[JLGWhiz]

OK, LiAD. lets try it this way. I changed it from the BeforeClose event to
the Open event. This will allow the data entered in B6 thru the last copied
row of the receiving sheets to be cleared before any revised data is copied.
This way, the copied data will be available for review and use until the
workbook is closed and then re-opened. My problem, previously, was in
understanding why you would want to copy data that would not be used, which
is what would have happened by using the BeforeClose Event. Try this and
see if it does not more satisfactorily meet your needs.

Private Sub Workbook_Open()
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")
ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
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
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

 

[LiAD]

Perfect

Thanks for sticking with it

OK, LiAD. lets try it this way. I changed it from the BeforeClose event to
the Open event. This will allow the data entered in B6 thru the last copied
row of the receiving sheets to be cleared before any revised data is copied.
This way, the copied data will be available for review and use until the
workbook is closed and then re-opened. My problem, previously, was in
understanding why you would want to copy data that would not be used, which
is what would have happened by using the BeforeClose Event. Try this and
see if it does not more satisfactorily meet your needs.

Private Sub Workbook_Open()
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")
ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
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
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

 

[JLGWhiz]

Glad to help. Beats watching the grass grow.

Perfect

Thanks for sticking with it