VBA excel copier/coller une ligne à partir d'une colonne dans un même workbook

[Aimedija]

Bonjour,
j'aurais une question assez basique mais qui pour mon niveau me pose encore probléme;
Alors , je dispose du code ci-dessous qui me permet de copier/coller des cellules d'une feuille vers une autre qui fonctionne parfaitement.

 Sub GenerateReport()
  Application.ScreenUpdating = False
  Sheets("query").Select
  Range("B1:B1000,E1:E1000,F1:F1000,H1:H1000,I1:I1000,J1:J1000,K1:K1000,N1:N1000").Select
  Selection.Copy
  Sheets("Compare").Select
  Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

J'aimerais pouvoir copier l'entièreté d'une ligne en désignant le nom du client en colonne A. Par exemple
selon la colonne client ci-dessous, je désire sélectionner et afficher toutes les lignes qui commence par le client Antoine sur une feuille puis toutes les lignes qui commence par Marcel sur un autre feuille et ainsi de suite.

Customer
Antoine
Marcel
Didier

Auriez -vous un conseil à me prodiguer? merci d'avance

 

[vgendron]

Bonjour

une méthode parmi tant d'autre
pour chaque "customer" ==> boucle For
filtrer la base sur le customer ==> voir selection.filter ==MIEUX: utiliser l'enregistreur de macro
copier coller les lignes affichées ==> voir specialcells(xlcelltypevisible)
client suivant

 

[Aimedija]

Merci mais je ne vois pas vraiment ce que tu veux dire, pourrais tu le mettre sous forme de code?

 

[vgendron]

bien sur, si tu postes un fichier exemple...ce sera plus simple

 

[Aimedija]

Bonjour,

Ci-joint le fichier xlsm ,

merci

 

[vgendron]

Mettre ce code dans un module standard

Sub QueryToCustomerData()
Application.ScreenUpdating = False

Set ListeCustomer = CreateObject("scripting.dictionary") 'création d'un objet "Dictionnaire"

With Sheets("query") 'avec la feuille Query
  
    For Each ele In .Range("tableau_Query[Customer]") 'on récupère la liste sans doublon des clients de la colonne "Customer" de la table
        ListeCustomer(ele.Value) = ""
    Next ele

    For Each Client In ListeCustomer.keys 'pour chaque client
        .ListObjects("Tableau_query").Range.AutoFilter Field:=1, Criteria1:=Client 'on active le filtre
        On Error Resume Next
        .ListObjects("Tableau_query").Range.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(Client & " Data").Range("A1") 'on copie les cellules filtrées dans la bonne feuille
        With Sheets(Client & " Data")
            .Columns("B:C").Delete 'on supprime les colonnes inutiles
            .Columns("D").Delete
        End With
    Next Client
    .ListObjects("Tableau_query").Range.AutoFilter Field:=1 'on désactive le filtre
End With
Application.ScreenUpdating = True
End Sub

 

[Aimedija]

Re-Hello,

le code fournie fonctionne bien pour l'exemple données , merci.

Néanmoins , j'ai un autre cas pratique et je n'arrive pas à appliquer le même code ,peut être est ce du au fait que mes colonnes ne sont pas vides?

Pourriez-vous y jeter un œil et me faire savoir d'où provient mon erreur? merci d'avance

 

[vgendron]

Bonjour

Dans ton second fichier, la table excel s'appelle "Tableau_query_1"..
il faut donc adapter le nom dans le code

la colonne Customer est arrivée en colonne B
il faut donc aussi adapter le filtre pour lui dire de filtrer sur la 2eme colonne, et plus la première

Sub QueryToCustomerData()

Application.ScreenUpdating = False

Set ListeCustomer = CreateObject("scripting.dictionary") 'création d'un objet "Dictionnaire"

With Sheets("query") 'avec la feuille Query
     For Each ele In .Range("Tableau_query_1[Customer]") 'on récupère la liste sans doublon des clients de la colonne "Customer" de la table
         ListeCustomer(ele.Value) = ""
     Next ele

     For Each Client In ListeCustomer.keys 'pour chaque client
         .ListObjects("Tableau_query_1").Range.AutoFilter Field:=2, Criteria1:=Client 'on active le filtre sur la colonne 2 (=colonne B = Colonne Customer)
         On Error Resume Next 'si la feuille n'existe pas, il y a une erreur qu'on bypasse: les données ne seront pas copiées..
         .ListObjects("Tableau_query_1").Range.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(Client & " Data").Range("A1") 'on copie les cellules filtrées dans la bonne feuille
         With Sheets(Client & " Data")
             '.Columns("B:C").Delete 'on supprime les colonnes inutiles
             '.Columns("D").Delete
         End With
     Next Client
     .ListObjects("Tableau_query_1").Range.AutoFilter Field:=2 'on désactive le filtre
End With

Application.ScreenUpdating = True
End Sub

 

[Aimedija]

Bonsoir VGendron,

Ton code est tout simplement splendide.

Merci pour le temps passé.