Do not have time to test your code but just an idea, I note that although you
have created an object reference to each worksheet, you have not qualified
some of the Range & Cell checks / tests to them - it may be, the your code
is returning results from the wrong sheet & this is why it fails??
I have added what I think you have omitted but check then see if this helps.
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" & ws2.Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & ws3.Cells(10, 2).End(xlDown).Row).Delete
ws4.Range("B6:J" & ws4.Cells(10, 2).End(xlDown).Row).Delete
ws5.Range("B6:J" & ws5.Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(ws1.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(ws1.Range("v" & c.Row).Value) = "X" Then
lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 +
1)
ElseIf c.Value = 4 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 +
1)
ElseIf c.Value = 6 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
ws1.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(ws1.Range("v" & c.Row).Value) = "X" Then
lr2 = ws3.Cells(ws3.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 +
1)
ElseIf c.Value = 10 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then
lr3 = ws2.Cells(ws2.Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5
ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 +
1)
End If
Next
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub
--
jb
"LiAD" wrote:
> The following code is supposed to:
>
> 1) Delete all the entries on sheets 2-5, (named Urgences, Imperatifs,
> Importants, Repariations), from cells B6 to J(end)
> 2) Copy any cells with a value of 10 in row K and an X in row V from Données
> to Urgences, and this continues for all of the values 10,8,6,4,2 all going to
> different sheets. In other others columns in Données I have a mix of number
> entries, text enrties etc some of which come from drop down lists.
>
> At the moment the code ONLY copies the data IF I have something written in
> cell I - this should not be part of code. Whether or not something is
> written in col I the code should copy the necessary data.
>
> I have tried changing every other item in the list to see if there is
> another condition affecting it - there is not.
>
> Does anyone know why this would be happening and how to resolve it?
>
> Thanks
> LiAD
>
>
>
> 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(ws1.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(ws5.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(ws4.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(ws4.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(ws3.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(ws2.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
>
Similar Threads
