Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code - JLGWhiz
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 dont, 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code - 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" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code - JLGWhiz
Perfect
Thanks for sticking with it "JLGWhiz" wrote: 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" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code - JLGWhiz
Glad to help. Beats watching the grass grow.
"LiAD" wrote in message ... Perfect Thanks for sticking with it "JLGWhiz" wrote: 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" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy code | Excel Programming | |||
VBA code does not copy and paste to next row for each zip code | Excel Programming | |||
Help With VBA Copy Code | Excel Programming | |||
Got the Copy/Cut Code But what is the Paste Code | Excel Programming | |||
Code to copy range vs Copy Entire Worksheet - can't figure it out | Excel Programming |