Mise en forme (copier coller) selon différente zone jointe (union)

Question

Je suis embêtée sur un "projet" qui me demande la réalisation de formalisme précis à chaque feuille. Sur chaque feuille il y a donc du formalisme, des formules à reprendre et étendre etc. Je ne prendrai que l'exemple d'une des feuilles, feuille A. L'idée c'est de créer le résultat attendu (ligne 49 à 84 de la feuille A), mon problème se pose clairement pour détecter mes zones précises à reconstruire. Ce que j'ai penser faire c'était (code VBA aussi en module 1) : - à partir de nom de colonne existant sur toutes les feuilles, faire de la reconnaissance de texte - donc récupère les données à partir de "Country code" vers "Service", copie-colle en décaler, puis de "Currency" vers "*Comment*" copie-colle à côté de cette zone créé, etc 1er problème : même si j'arrive à trouver mon texte et à leur donner un nom, la nouvelle zone jointe par une union (appelée "NewAreaU1") me conserve quand même la colonne a, qui n'est pas désirée ici. 2ième problème : sur ce fichier anonymisé j'ai une erreur sur mon code sur les selection multiple, que je n'avais pas dans mon fichier non-anonyme 3 ième problème : ... bien sûr que j'y ai passé une grande partie de mon week-end et que ce projet est "urgent" et "pour la semaine dernière" et bien sûr que je me décide à poster cela un dimanche soir 21h40.. et que tout cela est très logique. Bref, j'ai cru que ce serait easy et ben en fait non... Voilà. Si quelqu'un passe par là et voit ma lumière, qu'il entre (sans jeu de mot sexuel promis !!! ) Une bonne soirée, bon début de semaine et merci, Sub a_encours() Dim UnionRange1, UnionRange2, UnionRange3, NewAreaU1, NewAreaU2, NewAreaU3 As Range Dim dLigA As Long Sheets("A").Select 'Call SheetCells '=========================================================================FIRST PART DATA COPY '============================================================================================== Set StartRange = Rows(1).Find(what:="Country Code", LookAt:=xlWhole) Names.Add Name:="SR", RefersToR1C1:=StartRange Set EndRange = Rows(1).Find(what:="Service", LookAt:=xlWhole) Names.Add Name:="ER", RefersToR1C1:=EndRange Set a = Range(Range("SR").End(xlDown), Range("SR")) Set b = Range(Range("ER").End(xlDown), Range("ER").End(xlToLeft)) Set UnionRange1 = Union(a, b) 'union of 2 ranges UnionRange1.Select Selection.Copy Cells(Rows.Count, 1).End(xlUp).Offset(10, 0).Select Selection.PasteSpecial Set NewAreaU1 = ActiveCell.CurrentRegion Names.Add Name:="NewAreaU1", RefersToR1C1:=NewAreaU1 '=========================================================================SECOND PART DATA COPY '============================================================================================== Set StartRangeB = Rows(1).Find(what:="Currency*", LookAt:=xlWhole) Names.Add Name:="SRnum2", RefersToR1C1:=StartRangeB Set EndRangeB = Rows(1).Find(what:="*Comment*", LookIn:=xlValues, LookAt:=xlWhole) Names.Add Name:="ERnum2", RefersToR1C1:=EndRangeB Set a2 = Range(Range("SRnum2").End(xlDown), Range("SRnum2")) Set b2 = Range(Range("ERnum2").End(xlDown), Range("ERnum2").End(xlToLeft)) Set UnionRange2 = Union(a2, b2) 'union of 2 ranges 'LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'LastCol = Cells(Rows.Count, Columns.Count).End(xlToLeft).Column UnionRange2.Select Selection.Copy NewAreaU1.Offset(0, L10).Select Selection.PasteSpecial Set NewAreaU2 = Selection Names.Add Name:="NewAreaU2", RefersToR1C1:=NewAreaU2 '=========================================================================THIRD PART DATA CREATION THIS TIME '=========================================================================================================== Set StartRangeC = NewAreaU2.Rows.Find(what:="Currency*", LookAt:=xlWhole) Names.Add Name:="SRnum3", RefersToR1C1:=StartRangeC Set EndRangeC = NewAreaU2.Rows.Find(what:="*Comment*", LookIn:=xlValues, LookAt:=xlWhole) Names.Add Name:="ERnum3", RefersToR1C1:=EndRangeC Set a3 = Range(Range("SRnum3").End(xlDown), Range("SRnum3")) Set b3 = Range(Range("ERnum3").End(xlDown), Range("ERnum3").End(xlToLeft)) Set UnionRange3 = Union(a3, b3) 'union of 2 ranges 'LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'LastCol = Cells(Rows.Count, Columns.Count).End(xlToLeft).Column UnionRange3.Select Selection.Copy NewAreaU2.Offset(0, L10).Select Selection.PasteSpecial Set NewAreaU3 = Selection Names.Add Name:="NewAreaU3", RefersToR1C1:=NewAreaU3 End Sub...

78chris · Answer

Tu as quoi au départ ? Car là avec un même tableau dupliqué n fois ce n'est pas clair... A priori faisable par PowerQuery plus simplement que par VBA Les titres des colonne sont vraiment des lettres ? Si non il faut les véritables titres...

BsAlv · Answer

Une proposition pour votre fichier en PJ, pas encore pour le vrai fichier. Je ne comprends pas les formules que vous utilisez. macro "a_encours2" (j'ai caché plusieurs lignes)...

78chris · Answer

RE Tu ne réponds pas aux questions : pourquoi en A la plage A1:F36 est répétée en A94:F129 et A139:F194 ? quid des titres réels .....

Invité · Answer

Une proposition à améliorer ... À savoir : le code supprime les lignes de 90 à 190 avant le traitement. Les noms des champs nommés sont supprimés au début, puisqu'ils sont créés par la suite. Bizz...

Invité · Answer

Je suis bien heureux d'avoir pu aider un tantinet. J'ai bien aimé cette façon d'utiliser des champs nommés, c'était intéressant. En tant qu'amateur Vba d’Excel, je mets cette méthode dans ma besace. Bon projet. Au plaisir, Bizz...

Invité · Answer

Evitons les ".Sélect" tant que c'est possible. Donc : UnionRange4.Select Set GeneralDiscountArea = Selection Names.Add Name:="GeneralDiscountArea", RefersToR1C1:=GeneralDiscountArea Devient : '''UnionRange4.Select Set GeneralDiscountArea = UnionRange4 'Selection Names.Add Name:="GeneralDiscountArea", RefersToR1C1:=GeneralDiscountArea Bizz...