Erreur 438 + Amélioration code créé

Ritalachose

Nouveau membre
Bonjour,

j'ai réussi à créer un code en récupérant des informations un peu partout le problème c'est qu'en voulant en rajouter un morceau j'ai maintenant une erreur 438 qui est apparue..

Mon code est le suivant :

Code:
Sub TriCopie()
'
' Macro2 Macro
' Tri
'

'
    Sheets("COPIE BASE NEW").Range("$A$1:$AW$64513").AutoFilter Field:=6, Criteria1:=Array( _
        "Grammage Répartition", "Taux d Humidité Répartition", "Taux Liant Répartition") _
        , Operator:=xlFilterValues
    Columns("A:AW").Copy
    Sheets("Feuille_tampon").Range("A1").Paste

End Sub

Sub CARCOUSTIC_D()

Dim cel As Range
With Sheets("Certificat_CARCOUSTIC_D")
   .Range(.[A26], .[L26].End(xlDown)).Clear
End With
For Each cel In Range([E2], [E65532].End(xlUp))
   If cel.Value = "84322" Then
      Range(Cells(cel.Row, "L"), Cells(cel.Row, "L")).Copy Sheets("Certificat_CARCOUSTIC_D").[A65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "E"), Cells(cel.Row, "E")).Copy Sheets("Certificat_CARCOUSTIC_D").[B65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "K"), Cells(cel.Row, "K")).Copy Sheets("Certificat_CARCOUSTIC_D").[C65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "C"), Cells(cel.Row, "C")).Copy Sheets("Certificat_CARCOUSTIC_D").[D65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "F"), Cells(cel.Row, "F")).Copy Sheets("Certificat_CARCOUSTIC_D").[E65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "AE"), Cells(cel.Row, "AH")).Copy Sheets("Certificat_CARCOUSTIC_D").[F65532].End(xlUp).Offset(1, 0)

   End If
Next
For Each cel In Range([E2], [E65532].End(xlUp))
   If cel.Value = "84212" Then
      Range(Cells(cel.Row, "L"), Cells(cel.Row, "L")).Copy Sheets("Certificat_CARCOUSTIC_D").[A65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "E"), Cells(cel.Row, "E")).Copy Sheets("Certificat_CARCOUSTIC_D").[B65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "K"), Cells(cel.Row, "K")).Copy Sheets("Certificat_CARCOUSTIC_D").[C65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "C"), Cells(cel.Row, "C")).Copy Sheets("Certificat_CARCOUSTIC_D").[D65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "F"), Cells(cel.Row, "F")).Copy Sheets("Certificat_CARCOUSTIC_D").[E65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "AE"), Cells(cel.Row, "AH")).Copy Sheets("Certificat_CARCOUSTIC_D").[F65532].End(xlUp).Offset(1, 0)

   End If
Next
For Each cel In Range([E2], [E65532].End(xlUp))
   If cel.Value = "85324" Then
      Range(Cells(cel.Row, "L"), Cells(cel.Row, "L")).Copy Sheets("Certificat_CARCOUSTIC_D").[A65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "E"), Cells(cel.Row, "E")).Copy Sheets("Certificat_CARCOUSTIC_D").[B65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "K"), Cells(cel.Row, "K")).Copy Sheets("Certificat_CARCOUSTIC_D").[C65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "C"), Cells(cel.Row, "C")).Copy Sheets("Certificat_CARCOUSTIC_D").[D65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "F"), Cells(cel.Row, "F")).Copy Sheets("Certificat_CARCOUSTIC_D").[E65532].End(xlUp).Offset(1, 0)
      Range(Cells(cel.Row, "AE"), Cells(cel.Row, "AH")).Copy Sheets("Certificat_CARCOUSTIC_D").[F65532].End(xlUp).Offset(1, 0)

   End If
Next

Sheets("Certificat_CARCOUSTIC_D").Activate
End Sub

C'est apparemment sur la macro TriCopie que le problème se trouve la deuxième partie marche bien seule.
J'aurais également une seconde question concernant l'amélioraion possible de la 2ème macro : j'ai copier/collé le code en changeant le numéro (lignes 23, 34 et 45 du code ci-dessus) mais j'imerais savoir si on ne peut pas le faire en une fois?
J'ai essayé un truc du genre :
Code:
If cel.Value="85324" or "84212" or...
ça ne marche pas vraiment!

Il faudra ensuite que je crée un code pour obtenir une mise en forme appropriée mais ce sera dans un 2ème temps une fois que ces problèmes là seront résolus, chaque chose en son temps! :)

Merci en tout cas à ceux qui prendront le temps de m'aider sur ce problème!

 

drul

Obscur pro du hardware
Staff
Pour la question 1, malheureusement pas d'idée (à part d'éviter d'utiliser le press papier)
Code:
' Sans presse papier:
Columns("A:AW").Copy Sheets("Feuille_tampon").Range("A1")

Pour la question 2, plein de solution, en voici une:
Code:
Sub nnnn()
machin = Application.Match(Cells(1, 1).Text, Array("10", "20", "30"), 0)
If Not IsError(machin) Then
    MsgBox ("www")
End If
End Sub
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 132
Messages
6 718 005
Membres
1 586 388
Dernier membre
mery2005
Partager cette page
Haut