PC Review


Reply
Thread Tools Rate Thread

Copy code that partly works

 
 
LiAD
Guest
Posts: n/a
 
      5th Nov 2009
Hi,

I have the following code which is not working a required, its only copying
one item from one field. I can't find any differences between the data, its
all formatted the same etc. It is in as a workbook code.

Would anyone be able to tell me why this might not work please?

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
 
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
DVD works on Laptops & partly on DVD Player or PS2 Zoe Windows XP MovieMaker 8 13th Mar 2008 12:29 AM
import of ACT 6 data only partly works ? =?Utf-8?B?U2NvdHQgUw==?= Microsoft Outlook BCM 0 20th Nov 2006 11:37 PM
partly dutch, partly english Martijn Mulder Microsoft C# .NET 1 12th May 2006 02:12 PM
combo box only works partly =?Utf-8?B?U2FuZHlS?= Microsoft Access 0 4th May 2006 05:04 PM
ldap_init() can partly work but ldap_open works well =?Utf-8?B?bGRhcF9pbml0KCkgd29ya3Mgc3RyYW5nZQ==?= Microsoft VC .NET 1 11th Aug 2004 08:29 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 07:58 AM.