Copy if code
 

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 are 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(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

Thanks
LiAD

Copy if code
 

The XLUP and XLDown don't always work the way you would expect them to
work if cells were cleared of data. XLUP and XLDOWN still thinks there
is data in a cell that has been cleared, or there may be a Conditional
Formating in the cell which these two functions then condsiders the
cells having data.

What I often have to fix the problem is to delete all the empty rows
and columns on the worksheet. If the last row of data in the workbook
is 10. I will delete the rows 11:65536. Then repeat with the columns
and save the workbook.


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=152278

Microsoft Office Help