Copier les données d'une feuille et les coller sur une autre feuille

Bonjour à tous,

Cela fait quelques jours que je galère pas mal à faire une macro ou une formule pour pouvoir copier des données de ma feuille 1 sur ma feuille 2 en respectant un certain nombre de critères.

Par exemple j'aimerais récupérer sur la feuille 1 tous les comptes commençant par 70265 et les copier sur le tableau de la feuille 2 avec la date, le fournisseur, le numéro de compte et le solde.

J'ai essayé avec une recherche V, mais cela ne fonctionne pas.

Je me suis alors tournés vers du VBA, ce que j'ai fait, c'est que j'ai fait une MFC, j'ai enregistré une macro copier/coller en fonction d'un code couleur, mais ce n’est pas top top.

Par ailleurs, j'ai vu que depuis 2010 excel intégré le Displayformat pour pouvoir copier des données en fonction d'une couleur, mais je n’y arrive toujours pas, si y'a une âme généreuse qui pourrait éventuellement m'aider à résoudre ce petit souci, elle aura toute ma gratitude.

Arigatooo :)

Bonjour Score et bienvenu, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous dans le Module4 :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K1 As Integer 'déclare la variable K1 (incrément)
Dim K2 As Integer 'déclare la variable K2 (incrément)
Dim TL1() As Variant 'déclare la variable TL1 (Tableau des Lignes 1)
Dim TL2() As Variant 'déclare la variable TL2 (Tableau des Lignes 2)

Set OS = Worksheets("Feuille 1") 'définit l'onglet OS
Set OD = Worksheets("Feuille 2") 'définit l'onglet OD
OD.Range("A1").CurrentRegion.Offset(2, 0).EntireRow.ClearContents 'efface d'éventuelles anciennes valeurs dans l'onglet OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
    If Left(TV(I, 2), 5) = "70265" Then 'condition 1 : si la donnée ligne I colonne 2 de TV commence par "70265"
        K1 = K1 + 1 'incrémente K1
        ReDim Preserve TL1(1 To UBound(TV, 2), 1 To K1) 'redimensionne le tableau des lignes TL1 (autant de ligne que TV a de colonnes, K1 colonnes)
        For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
            TL1(J, K1) = TV(I, J) 'récupère dans la ligne J de TL1 la donnée en colonne J de TV (=> Transposition)
        Next J 'prochaine colonne de la boucle 2
    End If 'fin de la condition 1
    If Left(TV(I, 2), 11) = "70266 - 748" Then 'condition 2 : si la donnée ligne I colonne 2 de TV commence par "70265 - 748"
        K2 = K2 + 1 'incrémente K1
        ReDim Preserve TL2(1 To UBound(TV, 2), 1 To K2) 'redimensionne le tableau des lignes TL1 (autant de ligne que TV a de colonnes, K2 colonnes)
        For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
            TL2(J, K2) = TV(I, J) 'récupère dans la ligne J de TL2 la donnée en colonne J de TV (=> Transposition)
        Next J 'prochaine colonne de la boucle 2
    End If 'fin de la condition 2
Next I 'ptochaine ligne de la boucle  1
'si K1 est supérieure a zéro, renvoie le tableau TL1 transposé dans C3 redimensionnée de l'onglet OS
If K1 > 0 Then OD.Range("C3").Resize(K1, UBound(TV, 2)).Value = Application.Transpose(TL1)
'si K2 est supérieure a zéro, renvoie le tableau TL2 transposé dans I3 redimensionnée de l'onglet OS
If K2 > 0 Then OD.Range("I3").Resize(K2, UBound(TV, 2)).Value = Application.Transpose(TL2)
End Sub

Le fichier :

Bonjour ThauTheme,

Un grand merci pour ta réponse, ta macro fonctionne parfaitement.

Je te souhaite une agréable journée, et encore une fois, merci infiniment

Re bonsoir à tous,

Juste un petite question, à votre avis je devrais utiliser quel(les) formule(s) pour pouvoir adapter la macro sur un tableau vertical ? Comme celui joint, et j'aimerais bien étendre la formule pour d'autres comptes, mais lorsque j'essaie ça ne fonctionne pas, j'ai essayé de modifier le numéro de compte directement sur la macro (j'ai modifié IF Left(Tv(I, 2), 5) = "70265" par "748", mais ça me donne rien, une petite idée ?

Merci par avance

Bonjour,

Ça l'air de bien fonctionner, je vais décortiquer ta macro pour mieux comprendre son fonctionnement ^^.

Merci beaucoup