Optimiser code coier/coller sans doublons

Bonjour ,

Dans le fichier joint ,je cherche à faire ce que j'ai mis en titre

J'ai fais une macro qui fonctionne à peu près bien

Est-il possible de l'améliorer

Je vous remercie

Bonjour Joco7915,

Oui c'est probablement possible si on avait un classeur représentatif, si on savait quoi copier, si on savait où copier, si on savait si la zone destination est à effacer ou non, si on savait si les données copiées doivent remplacer les données de destination ou bien être accolées à celles déjà existantes, si on savait si supprimer les doublons concerne la zone à copier ou bien la zone de destination...

Bonjour mafraise,

Et ben dis donc t'en poses des questions (lol)
Cordialement et au plaisir

Bonjour à vous 2

Avec toutes mes excuses pour cet oubli

Il s'agit de copier et coller les plages en jaune des feuil1 et feuil 2 dans la plage en jaune de la feuil3

les plages coller doivent se mettre l'une en dessous de l'autre

Supprimer les doublons dans la plage de reception

A titre indicatif dans le fichier original j'ai 8 plages a copier /coller

Crdlt

re,

c'est chaque fois à peu près la même chose ...

Re, bonjour BsLav ,,

Ma petite version...

Le code dans module1:

Sub CopierCollerUnique()
Dim F, P, i&
Const Feuilles = "Feuil1/Feuil2/Feuil4"   ' les feuilles contenant les plages à copier
Const Plages = "c2:c9/c2:c10/a1:a17"      ' les plages à copier au sein de chaque feuille
Dim destination As Range, xrgDest As Range

   ' initialisation
   Application.ScreenUpdating = False
   Set destination = Sheets("Feuil3").Range("d5")     ' la feuille et cellule de destination
   F = Split(Feuilles, "/"): P = Split(Plages, "/")   ' les tableaux des feuilles et des plages

   ' effacer ou non la zone résultat (suivant ce que désire le demandeur")
   rep = MsgBox("voulez-vous d'abord effacer la plage de destination ?", vbQuestion + vbYesNo + vbDefaultButton2)
   If rep = vbYes Then Range(destination, destination.EntireColumn.Cells(Rows.Count, 1)).Clear

   ' copies
   For i = 0 To UBound(F)
      ' xrgDest est la cellule de destination
      Set xrgDest = destination.EntireColumn.Cells(Rows.Count, 1).End(xlUp)
      If xrgDest.Row < destination.Row Then Set xrgDest = destination Else Set xrgDest = xrgDest.Offset(1)
      Sheets(F(i)).Range(P(i)).Copy xrgDest     ' copie
   Next i

   ' supprimer les doublons sur la feuille résultat
   Set xrgDest = destination.EntireColumn.Cells(Rows.Count, 1).End(xlUp)  ' plage résultat
   ' suppression des doublons
   If xrgDest.Row > destination.Row Then Range(destination, xrgDest).RemoveDuplicates Columns:=1, Header:=xlNo
   Application.Goto destination.Parent.Range("a1"), True
End Sub

Bonjour mafraise , BsAlv

Merci pour votre aide

@mafraise j'ai testé il y a un beug sur cette lignes

rep = MsgBox("voulez-vous d'abord effacer la plage de destination ?", vbQuestion + vbYesNo + vbDefaultButton2)

@BsAlv

J'ai mis en place sur le fichier original tout fonctionne comme voulu

Crdlt

A+

Re,

Dire qu'il y a une erreur ne sert à rien. On précise l'erreur qui s'affiche.

Il faut sans doute sans doute déclarer rep dans l'instruction Dim.