PC Review


Reply
Thread Tools Rate Thread

Copy if code

 
 
LiAD
Guest
Posts: n/a
 
      9th Nov 2009
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
 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy all code to file or print all code cp2599@yahoo.com Microsoft Access Forms 2 28th Apr 2009 10:04 PM
VBA code does not copy and paste to next row for each zip code Miguel Microsoft Excel Programming 5 14th Nov 2008 03:13 PM
Got the Copy/Cut Code But what is the Paste Code Corey Microsoft Excel Programming 7 7th Jul 2006 02:23 PM
vba copy code Paul Microsoft Excel Programming 1 13th Feb 2005 03:28 PM
Code to copy range vs Copy Entire Worksheet - can't figure it out Mike Taylor Microsoft Excel Programming 1 15th Apr 2004 08:34 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 05:21 AM.