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

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

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