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