Copier données et coller à la suite ds une autre feuille

Bonjour à tous,

J'aurai besoin d'aide sur une macro que je suis en train de faire. Je souhaite récupérer des données dans un tableau où il y a beaucoup d'informations et les copier dans 3 tableaux différents (situés sur 3 feuilles différentes) en fonction des informations qu'il y a dans le tableau d'origine.

J'arrive bien à trouver l'information avec une boucle dans le tableau d'origine afin qu'il copie les information nécessaire mais dès que je veux coller les informations dans une autre feuille ça bogue. Ce que je souhaite c'est que mes informations viennent au fur et à mesure se coller à la suite dans les différents tableau.

Voici mon code:

Sub VERIF_FACTURE()

Dim ligne, n, j As Integer

    Worksheets("Facture").Activate
    Range("AG2").Select
    fin = Range("AG1").End(xlDown).Row
    j = 2

For n = 2 To fin

'Si dans la facture le produit est PRIMO j'affecte les données dans l'onglet MESSAGERIE
    If Cells(n, 33).Value = "PRIMO" Then
    Union(Cells(n, 11), Cells(n, 14), Cells(n, 15), Cells(n, 16), Cells(n, 19), Cells(n, 20), Cells(n, 22)).Select
    Selection.Copy
    Range("MESSAGERIE!A" & j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    j = j + 1

    ElseIf Cells(n, 33).Value = "GARANTISSIMO" Then
    Union(Cells(n, 11), Cells(n, 14), Cells(n, 15), Cells(n, 16), Cells(n, 19), Cells(n, 20), Cells(n, 22)).Select
    Selection.Copy
    Range("EXPRESS!A" & j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    j = j + 1

    If Cells(n, 7).Value = "AFFRET" Then
    Union(Cells(n, 11), Cells(n, 14), Cells(n, 15), Cells(n, 16), Cells(n, 19), Cells(n, 20), Cells(n, 22)).Select
    Selection.Copy
    Range("AFFRET!A" & j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    j = j + 1

    End If
    End If

Next n

End Sub

le blocage se produit au niveau du range : Range("MESSAGERIE!A" & j).Select

Je vous joins mon fichier en pièce joint ça permet d'aider à comprendre.

J'espère que j'ai été clair.

Quelqu'un aurait-il une idée.

Bonjour cv13, le forum,

Voici ton code, avec la correction de ton erreur. Attention, ton code peut être amélioré, je n'ai pas modifié grand chose, je suis très loin d'être calée en vba, mais je suis sûre qu'un autre membre s'occupera de ça !

Ton souci venait de Range("MESSAGERIE!A", j) qui s'écrit Feuil2.Range("A" & j) :

Sub VERIF_FACTURE()

Dim ligne, n, j As Integer

    Worksheets("Facture").Activate
    Range("AG2").Select
    fin = Range("AG1").End(xlDown).Row
    j = 2

For n = 2 To fin

'Si dans la facture le produit est PRIMO j'affecte les données dans l'onglet MESSAGERIE
    If Cells(n, 33).Value = "PRIMO" Then
    Union(Cells(n, 11), Cells(n, 14), Cells(n, 15), Cells(n, 16), Cells(n, 19), Cells(n, 20), Cells(n, 22)).Copy
   Feuil2.Range("A" & j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    j = j + 1

    ElseIf Cells(n, 33).Value = "GARANTISSIMO" Then
    Union(Cells(n, 11), Cells(n, 14), Cells(n, 15), Cells(n, 16), Cells(n, 19), Cells(n, 20), Cells(n, 22)).Select
    Selection.Copy
    Feuil4.Range("A" & j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    j = j + 1

    If Cells(n, 7).Value = "AFFRET" Then
    Union(Cells(n, 11), Cells(n, 14), Cells(n, 15), Cells(n, 16), Cells(n, 19), Cells(n, 20), Cells(n, 22)).Select
    Selection.Copy
   Feuil3.Range("A" & j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    j = j + 1

    End If
    End If
Next n
End Sub

Amicalement

Bonjour Walden,

Je te remercie, toutefois tu as raison mon problème c'est que la macro ne s'exécute pas jusqu'à la fin. C'est à mon avis au niveau de la boucle, elle s'arrête avant la fin.

A quel niveau pour toi il y a une amélioration à faire dans ma macro?

Bonjour

Une façon de faire à vérifier

Option Explicit

Sub VERIF_FACTURE()
Dim N As Long, Fin As Long

  Application.ScreenUpdating = False
  Worksheets("Facture").Activate
  ' AG n'est pas une colonne complète : Il faut prendre par exemple la colonne K
  Fin = Range("K1").End(xlDown).Row

  For N = 2 To Fin
    'Si dans la facture le produit est PRIMO j'affecte les données dans l'onglet MESSAGERIE
    If Cells(N, 33) = "PRIMO" Then
      Union(Cells(N, 11), Cells(N, 14), Cells(N, 15), Cells(N, 16), Cells(N, 19), Cells(N, 20), Cells(N, 22)).Copy
      Sheets("MESS").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    ElseIf Cells(N, 33) = "GARANTISSIMO" Then
      Union(Cells(N, 11), Cells(N, 14), Cells(N, 15), Cells(N, 16), Cells(N, 19), Cells(N, 20), Cells(N, 22)).Copy
      Sheets("EXPRESS").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    ' Dans la colonne G il n'y a pas AFFRET seulement AFFR
    ElseIf Cells(N, 7) = "AFFR" Then
      Union(Cells(N, 11), Cells(N, 14), Cells(N, 15), Cells(N, 16), Cells(N, 19), Cells(N, 20), Cells(N, 22)).Copy
      Sheets("AFFRET").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
  Next N
  Application.CutCopyMode = False
End Sub

Bonsoir BANZAI64,

Quand j'exécute la macro j'ai une erreur "la méthode PasteSpecial de la classe range a échoué" c'est donc au niveau du code ci-dessous qu'il y a un problème :

Sheets("MESS").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Saurais-tu d'où ça peut venir?

Re banzaï64,

Effectivement ça fonctionne bien j'avais mal retranscrit ton code.

Je te remercie.