Copier les données dans une autre feuille VBA

Bonjour,

SVP j'ai besoin d'un code VBA qui sert à copier tout la ligne avec numéro de pays unique qui se répète pas ( exemple : ligne avec numéro 4, 10, 11, 12, ...) dans la "Feuil2", et de copier tout les lignes avec numéro qui se répète de pays le même dans la "Feuil3" ( exemple : ligne avec numéro 1, 2, 3, 5, ...)

et merci d'avance

Bonjour achraf2020, le forum,

Tu n'as toujours pas répondu à ce post:

https://forum.excel-pratique.com/viewtopic.php?f=2&t=127712

Tu vas décourager les autres membres du forum à t'aider si tu ne fais pas l'effort de dire si la solution proposée te convient où non,

Je te propose donc encore un TCD.....à chaque modif sur la feuille BDD, les données s'actualisent.

https://support.office.com/fr-fr/article/cr%C3%A9er-un-tableau-crois%C3%A9-dynamique-pour-analyser-des-donn%C3%A9es-de-feuille-de-calcul-a9a84538-bfe9-40a9-a8e9-f99134456576

Cordialement,

Merci pour la reponse mais c'est pas ça ce que je cherche,

Je pense que vous n'avez pas bien compris ma question

Je veux copier tout les lignes avec le meme numero dans la feuille 2

et copier tout les lignes avec numero unique dans le feuille 3

je veux bien que sa soit un code vba generalise car les données sur lexcel c'est juste un exemple

et merci beaucoup

Re,

Merci pour ton retour,

Un essai....

Cordialement,

Merci sa marche bien c'est genial

Et si je veux copier a partir de la ligne 4 de la feuil1 et coller à partir de la ligne 4 sur l feuil2 et feuil3

dois je changé quoi sur le code ?

Dim i As Long, dl As Long, dl2 As Long, dl3 As Long

  Call efface

 dl2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row + 1
 dl3 = Sheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row + 1

 Application.ScreenUpdating = False

 With Sheets("Feuil1")
  dl = .Range("A" & Rows.Count).End(xlUp).Row
   For i = 2 To dl
    If WorksheetFunction.CountIf(Columns(1), Cells(i, 1)) = 1 Then
     .Range("A1:K1").Copy Sheets("Feuil2").Range("A1")
     .Range("A" & i & ":K" & i).Copy Sheets("Feuil2").Range("A" & dl2)
     dl2 = dl2 + 1
    Else
     .Range("A1:K1").Copy Sheets("Feuil3").Range("A1")
     .Range("A" & i & ":K" & i).Copy Sheets("Feuil3").Range("A" & dl3)
     dl3 = dl3 + 1
    End If
   Next i
 End With

et merci d'avance

Re,

Les intitulés de colonne sont en ligne 3 ?

Sub test()

 Dim i As Long, dl As Long, dl2 As Long, dl3 As Long

  Call efface                                                   'efface les feuilles 2 et 3

 Application.ScreenUpdating = False                             'évite le scintillement de l'écran

 With Sheets("Feuil1")
  dl = .Range("A" & Rows.Count).End(xlUp).Row

       .Range("A3:K3").Copy Sheets("Feuil2").Range("A3")        'copie titre des colonnes
       .Range("A3:K3").Copy Sheets("Feuil3").Range("A3")        'copie titre des colonnes

        dl2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row + 1  'première ligne vide après les titres
        dl3 = Sheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row + 1  'première ligne vide après les titres

   For i = 4 To dl                                                        'boucle de la ligne 4 à la dernière ligne
    If WorksheetFunction.CountIf(Columns(1), Cells(i, 1)) = 1 Then        'si valeur unique (=1), copie sur feuille 2
     .Range("A" & i & ":K" & i).Copy Sheets("Feuil2").Range("A" & dl2)
     dl2 = dl2 + 1
    Else
     .Range("A" & i & ":K" & i).Copy Sheets("Feuil3").Range("A" & dl3)    'sinon copie sur feuille 3
     dl3 = dl3 + 1
    End If
   Next i
 End With
 Application.ScreenUpdating = True
End Sub

Cordialement,

C'est génial merciiiiiiiiiiiiiiiiiiiiiiiiiii

svp pour la macro efface ; si je veux aussi que ça commence de la 4 eme ligne

dois je changé quoi

Je n'ai plus de pc pour le moment, et je pars en vacances cette nuit, je passe donc la main.

Avec un peu de recul, je pense que je n'ai pas utilisé la méthode la plus efficace, on devrait pouvoir optimiser tout ça en une seule macro.

Un essai tout de même depuis mon téléphone :[code]sub efface

Dim i as integer, dl2 as integer, dl3 as integer

With sheets ("Feuil2")

dl2 =.range ("A"&Rows.count).end (xlup).row

For i = 3 To dl2

Rows (i).entirerow.delete

Next i

End with

With sheets ("Feuil3")

dl3=.range ("A"&rows.count).end (xlup).row

For i =3 To dl3

Rows (i).entirerow.delete

Next i

End with

End sub[code]

Si personne ne prend le relai( ce qui me surprendrai), je tenterai de te faire une meilleure proposition à mon retour.

A bientôt, 😎

SVP j'ai besoin d'une macro vba qui copie une selection à partir de "A3" jusqua dernier ligne en K

et aussi pour effacer la meme chose

et merci d'avance