Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code failing
Hi,
I have the following code which based upon the values in col K of sheet Données is supposed to take the data from rows B to K and copy them into the relevant sheet. The code is only copying certain lines at the moment. There is no differences in terms of format etc between the lines which it does/does not copy. Should this code work ok? Just a point - the file is on a shared network. Are there any settings that each computer needs to have to read it etc that may block? 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, ws4 As Worksheet Dim ws5 As Worksheet Set ws1 = Sheets("Données") Set ws2 = Sheets("Urgences") Set ws3 = Sheets("Imperatifs") Set ws4 = Sheets("Importants") Set ws5 = Sheets("Repariations") ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws5.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 = 2 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws5.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1) ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws4.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1) ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws4.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1) End If Next Set rng = ws1.Range("K9:K" & lr) Application.DisplayAlerts = False For Each c In rng If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws3.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1) ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then lr3 = ws2.Cells(Rows.Count, 9).End(xlUp).Row If lr3 < 6 Then lr3 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1) End If Next Application.DisplayAlerts = True ThisWorkbook.Save End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code failing
Without looking at the whole thing, I see this problem.
lr = ws1.Cells(Rows.Count, "K").End(xlUp).Row should be lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row I see that same problem in several other places as well. Since you're working on multiple worksheet objects, make sure you use the correct worksheet object (ws1, ws2, etc) in front of Range as well, otherwise, it'll default to the active sheet. HTH, Barb Reinhardt "LiAD" wrote: Hi, I have the following code which based upon the values in col K of sheet Données is supposed to take the data from rows B to K and copy them into the relevant sheet. The code is only copying certain lines at the moment. There is no differences in terms of format etc between the lines which it does/does not copy. Should this code work ok? Just a point - the file is on a shared network. Are there any settings that each computer needs to have to read it etc that may block? 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, ws4 As Worksheet Dim ws5 As Worksheet Set ws1 = Sheets("Données") Set ws2 = Sheets("Urgences") Set ws3 = Sheets("Imperatifs") Set ws4 = Sheets("Importants") Set ws5 = Sheets("Repariations") ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws5.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 = 2 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws5.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1) ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws4.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1) ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws4.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1) End If Next Set rng = ws1.Range("K9:K" & lr) Application.DisplayAlerts = False For Each c In rng If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws3.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1) ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then lr3 = ws2.Cells(Rows.Count, 9).End(xlUp).Row If lr3 < 6 Then lr3 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1) End If Next Application.DisplayAlerts = True ThisWorkbook.Save End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy code failing
I have changed this on all of the lines concerned but i still get the same
result - it copies only one entry out of the 8 it should. Any other ideas why this would happen? LiAD "Barb Reinhardt" wrote: Without looking at the whole thing, I see this problem. lr = ws1.Cells(Rows.Count, "K").End(xlUp).Row should be lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row I see that same problem in several other places as well. Since you're working on multiple worksheet objects, make sure you use the correct worksheet object (ws1, ws2, etc) in front of Range as well, otherwise, it'll default to the active sheet. HTH, Barb Reinhardt "LiAD" wrote: Hi, I have the following code which based upon the values in col K of sheet Données is supposed to take the data from rows B to K and copy them into the relevant sheet. The code is only copying certain lines at the moment. There is no differences in terms of format etc between the lines which it does/does not copy. Should this code work ok? Just a point - the file is on a shared network. Are there any settings that each computer needs to have to read it etc that may block? 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, ws4 As Worksheet Dim ws5 As Worksheet Set ws1 = Sheets("Données") Set ws2 = Sheets("Urgences") Set ws3 = Sheets("Imperatifs") Set ws4 = Sheets("Importants") Set ws5 = Sheets("Repariations") ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete ws5.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 = 2 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws5.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1) ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws4.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1) ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws4.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1) End If Next Set rng = ws1.Range("K9:K" & lr) Application.DisplayAlerts = False For Each c In rng If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then lr2 = ws3.Cells(Rows.Count, 9).End(xlUp).Row If lr2 < 6 Then lr2 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1) ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then lr3 = ws2.Cells(Rows.Count, 9).End(xlUp).Row If lr3 < 6 Then lr3 = 5 Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1) End If Next Application.DisplayAlerts = True ThisWorkbook.Save End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
piece of code keeps failing.... | Excel Programming | |||
Enabled property failing when code tries to set it | Excel Programming | |||
code failing in hidden rows | Excel Discussion (Misc queries) | |||
VBA - Code failing in Excel 97 | Excel Programming | |||
Excel Copy Method Failing. | Excel Programming |