Simplification code bis

[anber]

Rebonsoir le forum,

Ci-joint le bon code (voir message précédent).

For Each cel In Range("D9" & Range("D65536").End(xlUp).Row)
cel = RTrim(cel)
If cel = 1 Or cel = "A" Then
If Sheets("Moa").Range("A8") = "" Then
Set DEST = Sheets("Moa").Range("A8")
Else
Set DEST = Sheets("Moa").Range("A65536").End(xlUp).Offset(1, 0)
End If
Range(cel.Offset(0, -1), cel.Offset(0, 10)).Copy Destination:=DEST

ElseIf cel = 2 Or cel = "B" Then
If Sheets("Mov").Range("A8") = "" Then
Set DEST = Sheets("Mov").Range("A8")
Else
Set DEST = Sheets("Mov").Range("A65536").End(xlUp).Offset(1, 0)
End If
Range(cel.Offset(0, -1), cel.Offset(0, 10)).Copy Destination:=DEST

ElseIf cel = 8 Or cel = "C" Then
If Sheets("PP").Range("A8") = "" Then
Set DEST = Sheets("PP").Range("A8")
Else
Set DEST = Sheets("PP").Range("A65536").End(xlUp).Offset(1, 0)
End If
Range(cel.Offset(0, -1), cel.Offset(0, 10)).Copy Destination:=DEST

ElseIf cel = 9 Or cel = "D" Then
If Sheets("Che").Range("A8") = "" Then
Set DEST = Sheets("Che").Range("A8")
Else
Set DEST = Sheets("Che").Range("A65536").End(xlUp).Offset(1, 0)
End If
Range(cel.Offset(0, -1), cel.Offset(0, 10)).Copy Destination:=DEST
Next cel

Merci

 

[myDearFriend]

Bonsoir Anber, le Forum.

Tout d'abord Anber, tu n'avais pas besoin de doubler le fil de discussion pour poster ce rectificatif, il suffisait simplement de continuer sur le premier fil...

je n'ai pas testé, mais il me semble que le code ci-dessous pourrait déjà te servir de base :

Dim Cel As Range
Dim Feuil As String
Dim DEST As Range

   Application.ScreenUpdating = False
   For Each Cel In Range("D9" & Range("D65536").End(xlUp).Row)
      Cel = RTrim(Cel)
      Select Case Cel.Value
      Case 1, "A"
         Feuil = "Moa"
      Case 2, "B"
         Feuil = "Mov"
      Case 8, "C"
         Feuil = "PP"
      Case 9, "D"
         Feuil = "Che"
      End Select
      With Sheets(Feuil)
         If .Range("A8") = "" Then
            Set DEST = .Range("A8")
         Else
            Set DEST = .Range("A65536").End(xlUp).Offset(1, 0)
         End If
      End With
      Range(Cel.Offset(0, -1), Cel.Offset(0, 10)).Copy Destination:=DEST
   Next Cel
   Application.ScreenUpdating = True



Et, sauf erreur de ma part, il me semble qu'il manquait un "End If" avant la fin de ta boucle For Each....


Cordialement,
Didier_mDF

 

[anber]

Bonjour myDearFriend, le forum,

Merci pour ton code que je vais tester ce matin, en effet il manquant un "End If", le copier-coller est passé à côté.

Encore merci

Cordialement

BA

 

[CHti160]

Salut"anber"et salut "Didier"
bonjour le "FORUM"
peutx tu me dire si ce que je t'ai proposé à pu te servir
Auteur: anber (---.w83-193.abo.wanadoo.fr)
Date: 05-12-04 20:01
Pièce jointe: Classeur2.zip (7k)
il est bon avant de relancer un post de finaliser le précédant
ainsi tout et clair ,que la proposition soit bonne où pas
A+++
Jean Marie