Slt

Il faudrait mettre le code de la macro, ou même mieux, déposse le fichier sur www.cjoint.com On pourra ainsi mieux comprendre et t'aider.

Bonjour,

Euh... Qu'est-ce qui ne fonctionne pas ?

Si le problème est de rajouter les colonnes A et B, tu peux utiliser la macro suivante à la place de celle existante. (Mais il faut auparavant rajouter les deux colonnes dans toutes les autres feuilles.)

Sub copier()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Last As Integer
Dim o As Range
Dim Etab As String
Dim desti As Range
Dim Acopier, Acopier2, Tout
Sheets("BD").Select
Last = Range("O65000").End(xlUp).Row
For Each o In Range("O9:O" & Last)
' si "OUI" dans la cellule, il est déjà copié, le prg mets OUI apres la copie
If UCase(o) <> "OUI" Then
Etab = o.Offset(0, -11)
' mettre une remarque ! pas de n° de Facture
If o.Offset(0, -12) = "" Then o.Offset(0, -12).Value = "pas de n°de facture"
Set desti = Sheets(Etab).Range("C65000").End(xlUp)(2).Offset(0, -2)
Set Acopier = Range(o.Offset(0, -10), o.Offset(0, -1))
Set Acopier2 = Range(o.Offset(0, -14), o.Offset(0, -12))
Set Tout = Application.Union(Acopier, Acopier2)
Tout.Interior.ColorIndex = 19
Tout.Copy desti
o.Value = "Oui"
End If

Attention ! Cette macro comme la précédente est fortement dépendante du contenu. Si tu déplacesla colonne numéro facture ou établissement par exemple, ça ne marchera pas. C'est pourquoi ton modèle est assez peu compréhensible.

Mais si le but est juste de rajouter deux colonnes de données à gauche, alors ça ira comme ça.

A+

bonjour a toutes et a tous

et merci galopin01

pour le rajout de colonnes,mais voila se n'est pas gauche que je veut cet a droite

entre (montant ht et copie oui ou non) environ 5 a 6 colonnes

mais encore merci pour ton aide

je cherche de mon cote

a bientot

Donc tu nous mets un nouveau classeur modèle avec la nouvelle BD, les nouveaux en-têtes et une feuille établissement avec ses en-têtes comme tu les veux comme ça on saura quoi copier et ou.

A+

Bonsoir,

Remplacer la totalité de la macro existante par cette nouvelle.

Pas besoin de taper ! Il suffit de copier le texte ci-dessous et de le coller.

Nota : les lignes en rouge sont des commentaires qui indiquent ce que fera la prochaine ligne de la macro.

Sub copier()
'Définition des variables
Dim Last%, Etab$, o As Range, Desti As Range
Dim Acopier, Acopier2, Tout
'On se repère sur la colonne Oui/Non : actuellement c'est la colonne T
'On mémorise la dernière ligne de cette colonne repère
Last = Sheets("BD").Range("T65000").End(xlUp).Row
'Pour chaque cellule (o) dans la colonne T, de la ligne 9 à la ligne mémorisée (Last)
For Each o In Range("T9:T" & Last)
'On ne travaille que si la cellule contient autre chose que "Oui"
If UCase(o) <> "OUI" Then
'si ce n'est pas Oui, lire l'établissement 16 colonnes à gauche de la colonne T
'et on le mémorise dans une variable (Etab)
Etab = o.Offset(0, -16)
' mettre une remarque ! pas de n° de Facture
If o.Offset(0, -17) = "" Then o.Offset(0, -17).Value = "pas de n°de facture"
'On mémorise la cellule de destination de la feuille de destination mémorisée (Etab)
'...Dans une variable "Desti"
Set Desti = Sheets(Etab).Range("A65000").End(xlUp)(2)
'On mémorise le numéro de facture 17 colonnes à gauche dans une variable "Acopier"
Set Acopier = o.Offset(0, -17)
'On mémorise le reste dans une autre variable "Acopier2"
'depuis la colonne C (15 colonnes à gauche) jusqu'à la colonne S
Set Acopier2 = Range(o.Offset(0, -15), o.Offset(0, -1))
'On agrège tout ça dans une autre variable ("Tout")
Set Tout = Application.Union(Acopier, Acopier2)
'On met le tout en couleur
Tout.Interior.ColorIndex = 19
'On colle le tout dans la destination
Tout.Copy Desti
'Et on met un drapeau pour montrer que la ligne à été traitée
o.Value = "Oui"
End If
'Et on recommence jusqu'à ce qu'on ai passé en revue chaque cellule (o) dans la colonne T
Next
End Sub

A+

bonsoir

je te remercie je copie cela et te tien au courant de la suite des evenements

mais un grand a toi galopin01 tu es un chef

comme dit bérylion au pti ognons

a tres bientot pour les nouvelles

bonsoir

En et fait la macro et plus simple d’utilisation

Cela fonctionne aux pti ognons

J’ai même constaté que je pouvais modifier les textes du cartouche par autre chose

Etablissement par bâtiment etc. sans avoir a modifié la macro

Type top comme dit les ados

Juste question esthétique peut on mettre une ligne sur deux en différente couleur

Mais déjà cela fonction et fonctionnais avec une couleur il ne faut pas jour avec le feu

Encore merci beaucoup et très bientôt

bonsoir,

Peut on mettre une ligne sur deux en différente couleur ?

Oui mais il faudrait dissocier macro de transfert et macro de mise en forme. Car aucune ligne n'obéit à la même logique.

Imaginons que sur la BD les lignes impaires aient la couleur 1ç et les lignes paires la couleur 34

Qund tu vas copier une ligne paire de la feuille BD tu ne la colleras pas nécessairement sur une ligne paire en fait il y a une chance sur deux que ce soit une ligne impaire à l'arrivée.

La mise en forme devrait donc s'effectuer indépendament de la copie.

Une mise en forme conditionnelle serait possible mais inutilement lourde à gérer.

Tu peux coller la macro suivante dans le module "ThisWorkbook"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i%, iR%, iC%
'mémorise la ligne active
iR = Target.Row
iC = Target.Column
'Selon la feuille active
Select Case Sh.Name
'Si c'est la feuille "BD"
Case "BD"
'Si la colonne 3 a été modifiée et ligne > 8
If iR > 8 And iC = 3 Then
'mémorise la dernière colonne
i = Sh.Cells(8, 3).End(2).Column
'attribue une couleur (19 ou 34) aux cellules utiles
'selon que c'est une ligne impaire ou non
Sh.Range(Sh.Cells(iR, 3), Sh.Cells(iR, i)).Interior.ColorIndex = IIf(iR Mod 2 = 0, 19, 34)
End If
'Si ce n'est pas la feuille "BD"
Case Else
'Faire le même travail avec une autre plage utile...
If iR > 5 And iC = 1 Then
i = Sh.Cells(5, 3).End(2).Column
Sh.Range(Sh.Cells(iR, 1), Sh.Cells(iR, i)).Interior.ColorIndex = IIf(iR Mod 2 = 0, 19, 34)
End If
End Select
End Sub

Cette macro met en forme la ligne active à chaque changement dans la colonne N°de facture

en outre il convient de supprimer les deux lignes suivantes dans la Sub copier() :

'On met le tout en couleur
Tout.Interior.ColorIndex = 19

A+

bonjour

cela fonctionne meme tres bien voila une bonne chose

une petite question y a t 'il un bon livre pour apprendre mais vraiment pour debutant l'environnement VBA

avec des exemples pour mieux comprendre les mofications de texte et de ligne un vrai livre pour debutant

mais encore merci pour le travail

a tres bientot

Je serais tenté de répondre non !

Apprendre à programmer fusse Excel et VBA, c'est un peu comme apprendre à parler anglais ou... chinois ! D'abord on balbutie quelques mots en p'ti nèg' et puis on s'améliore petit à petit.

De 10 à 50 euros tous les livres sont ici Ne pas se sous-estimer : les livres trop basiques sont rapidement inutiles.

Un site que je conseille souvent aux débutants. Heureusement de nombreux autres sites et forums dédiés à Excel et VBA permettent d'éviter de réinventer la roue à chaque fois !

A+

Bonsoir

Galopin01

J’aurais de nouveau besoin d’un éclaircissement sur une petite erreur 9 que j’ai maintenant

Depuis un petit accident sur l’ordi (disque dur) mais rien avoir avec la macro

J’ai mis en fonction la macro que tu ma envoyer mais j’ai aussi modifié les feuilles établissement 1 2 3 etc. Par les noms des établissements et voila une erreur 9

Pourrais tu m’informer de la manipulation pour éviter ou détournée cette erreur

Merci

Amicalement

bonjour,

Une des feuilles ne correspond pas sans doute à cause d'une faute de frappe, espace en trop ou en moins au début ou à la fin soit sur l'onglet soit dans ton tableau.

A+

BONJOUR

galopin01

je viens de voir l'erreur la BD debuter par la ligne 9 et cellule c

et entre temps j'ai rajouté des lignes et la DB debute maintenant en 17 et toujour la cellule c

je viens de modifier For Each o In Range("T9:T" & Last) par For Each o In Range("T17:T" & Last)

qui normalement correspond a la ligne

mais encore merci

et bientot et peut etre bonne vacances

amicalement

junon

Bonjour,

Oui il est clair que l'usage des macros est étroitement lié à la structure de tes feuilles.

Pour pallier à cet inconvénient, les bricoleurs expérimentés utilisent des cellules nommées, ce qui permet de ne pas avoir à modifier les macros à chaque fois que tu modifies tes feuilles.

A+

Junhttp://cjoint.com/data/jdw7nBLqLp_dossier_esai2009.XLSon

voila le dossier

http://cjoint.com/?jdxcfRudbZ

a bientot

junon

bonjour,

Je te donne juste les lignes à modifier :

If o.Offset(0, -14) = "" Then o.Offset(0, -14).Value = "pas de n°de facture"
Set Acopier = o.Offset(0, -14)
Set Acopier2 = Range(o.Offset(0, -12), o.Offset(0, -1))

A+