Traduire en VBA

br44 · 20 Novembre 2009

Bonsoir le forum ,

je voudrais traduire en vba la condition suivante:

Ne sélectionner que les cellules rouges est supérieur à 0

afin de pouvoir complète le code suivant :

Sheets("SAISIE1").Range("P12:AO16").Copy Destination=Sheets("RECAP IMPAYER").Range("K13:AG17")

Vous remerciant par avance je vous dis à plus .Amicalement Br44

job75 · 20 Novembre 2009

Re : Traduire en VBA

Bonsoir br44,

Les plages que vous indiquez n'ont pas les mêmes dimensions 😉

Ne serait-ce pas AJ au lieu de AG :

Code:

Sheets("SAISIE1").Range("P12:AO16").Copy Destination=Sheets("RECAP IMPAYER").Range("K13:[COLOR="Red"]AJ[/COLOR]17")

Dans ce cas lancez cette macro :

Code:

Sub Copie()
Dim cel As Range
'Sheets("SAISIE1").Range("P12:AO16").Copy Destination=Sheets("RECAP IMPAYER").Range("K13:AJ17")
For Each cel In Sheets("SAISIE1").Range("P12:AO16")
  If cel > 0 And cel.Interior.ColorIndex = 3 Then _
    cel.Copy Sheets("RECAP IMPAYER").Range(cel.Offset(1, -5).Address)
Next
End Sub

A+

br44 · 21 Novembre 2009

Re : Traduire en VBA

Bonjour job75,le forum

un grand merci à vous pour cette réponse qui va me permettre d'avancer. puis-je vous demandez une petites explications sur la dernière lignes de votre macro :

Code:

cel.Copy Sheets("RECAP IMPAYER").Range(cel.Offset(1, [COLOR="Blue"]-5[/COLOR]).Address)

Pourquoi mettre -5 à cet endroit ?

Vous remerciant par avance je vous dis à bientôt sur se fil . Amicalement Br44

job75 · 21 Novembre 2009

Re : Traduire en VBA

Re,

Pour comprendre Offset(1, -5) voyez le décalage entre les 2 plages P12:AO16 et K13:AJ17 : +1 pour les lignes (12 => 13, 16 => 17) et -5 pour les colonnes (P => K, AO => AJ).

A+

br44 · 22 Novembre 2009

Re : Traduire en VBA

Bonjour Job75,le forum,

Merci pour votre réponse ainsi que pour les explications je vais essayer d'adapter votre macro à mon programme .

Si j'ai un souci je revient vers vous . Amicalement BR44

br44 · 25 Novembre 2009

Re : Traduire en VBA

Bonjour le forum ,Job75

je reviens vers vous pour m'aider à compléter votre macro . je suis désolé lors de mon premier message j'ai commis une erreur dans les plages que j' ai communiquer.je suis vraiment désolé🙁🙁🙁🙁 .

Oui je pensais juste copier ma la feuille "SAISIE1" dans ma feuille"RECAP IMPAYER" mais je suis aperçu que les tableau située dans cette dernière était incomplet .

Je vous joint la nouvelle macro :

Code:

[COLOR="Blue"]Sheets[/COLOR]("SAISIE1").Range (Range("P12:W16") [COLOR="Blue"]And[/COLOR] Range("Y12:AF16") [COLOR="Blue"]And[/COLOR] Range("AH12:AO16"))
.Copy Destination:=[COLOR="Blue"]Sheets[/COLOR]("RECAP IMPAYER").Range(Range("B12:I16") [COLOR="Blue"]And[/COLOR] Range("P12:W16")[COLOR="Blue"] And[/COLOR] Range("Y12:AF16"))

Pour infos : P12:W16=> B12:I16 soit un écxart de 14 colonnes vers la guache . J'ai essayer d'adapter votre macro mais je n'y suis pas arrivée .

Je joint également un fichier avec le programme et le nouveau tableau pour que se soit plus claire .

Vous remerciant par avances et m'excusant à nouveau pour mon erreur je vous dis à plus sur se fil . Amicalement Br44

job75 · 25 Novembre 2009

Re : Traduire en VBA

Bonjour br44,

Les And entre les Range pour faire un Range ce n'est pas possible, il faut utiliser Union.

Pour mémoire, on ne peut pas Copier/Coller des plages multiples sur des plages multiples : essayez manuellement et voyez.

Par ailleurs, les décalages ne sont pas les mêmes, Union ne marchera pas. Donc simplement, écrivez 3 fois le code que je vous ai donné, puisqu'il y a 3 plages.

Quant au fichier, pas compris grand'chose.

A+

job75 · 25 Novembre 2009

Re : Traduire en VBA

Re,

Les 2ème et 3ème plages ayant le même décalage -9, on peut les unir dans le même Range, donc 2 boucles seulement :

Code:

Sub Copie()
Dim cel As Range
'Sheets("SAISIE1").Range(Range("P12:W16") And Range("Y12:AF16") And Range("AH12:AO16")) _
'.Copy Destination:=Sheets("RECAP IMPAYER").Range(Range("B12:I16") And Range("P12:W16") And Range("Y12:AF16")) 'code erroné

For Each cel In Sheets("SAISIE1").Range("P12:W16")
  If cel > 0 And cel.Interior.ColorIndex = 3 Then _
    cel.Copy Sheets("RECAP IMPAYER").Range(cel.Offset(0, [COLOR="Red"]-14[/COLOR]).Address)
Next

For Each cel In Sheets("SAISIE1").Range("Y12:AF16,AH12:AO16")
  If cel > 0 And cel.Interior.ColorIndex = 3 Then _
    cel.Copy Sheets("RECAP IMPAYER").Range(cel.Offset(0, [COLOR="red"]-9[/COLOR]).Address)
Next

End Sub

A+

job75 · 25 Novembre 2009

Re : Traduire en VBA

Re,

Encore une chose. Si les données dans les plages copiées peuvent varier, il faut peut-être prévoir l'effacement préalable des plages de destination par :

Code:

Range("B12:I16,P12:W16,Y12:AF16").[COLOR="Red"]Clear[/COLOR]

A+

br44 · 25 Novembre 2009

Re : Traduire en VBA

Bonsoir Job75,le forum

Merci pour ces réponses rapides . je viens de tester la proposition de votre second message .

Vous dites:"Quant au fichier, pas compris grand'chose."

Les deux feuilles feuilles que j'ai poster sont juste là pour voire le décalage des colonnes .

Oui mont but est de placer cette macro dans un autres classeur avant que se ficher soit archivé .

Voici la macro concernée:

Code:

[COLOR="Green"]'Dèfinit la varible Chemin2[/COLOR]
   Chemin2 = "C:\RAPID\GESTION\SUIVI FACTURE.XLS"
[COLOR="Green"]'Dèfinit la varaible Wb4[/COLOR]
  [COLOR="Blue"]Set[/COLOR] Wb4 = Workbooks.Open(Chemin2)

   
[COLOR="Green"]'Copie est sauvegarde du SUIVI FACTURE de l'année[/COLOR]
  ActiveWorkbook.SaveCopyAs "C:\RAPID\SAUVEGARDE\SUIVI FACTURE\Client" & Year(Wb4.Sheets(15).[H122]) & ".XLS"
  
[COLOR="Green"]'J'efface les infos  aprés archvage[/COLOR]
Wb4.Sheets(Mois).Range("C8:R121")[COLOR="Blue"].Clear[/COLOR]
 [COLOR="Green"]'Enregistre les données du classeur "SUIVI FACTURE.XLS"[/COLOR]
   Wb4.[COLOR="Blue"]Save[/COLOR]
[COLOR="Green"] 'Fermeture du classeur "SUIVI FACTURE.xls"[/COLOR]
   Wb4[COLOR="Blue"].Close[/COLOR]

Juste pour m'infos personel y-t-il une modif pour que les infos s'affiche dans la feuille de destination parsque là je n'est rien ? la macro ne beug pas mais elle se fixe sur la colonnes "F" de la feuille "Saisie" .

Si vous avez une idée de se qui peut bloqué cela me m'aiderais à comprendre se qui se passe . De mon coté je regarde le fichier que j'ai mis et le change si nécessaire .

Vous remerciant pour tout je vous dis à plus .Amicalement BR44

job75 · 25 Novembre 2009

Re : Traduire en VBA

Re,

Toujours rien compris.

Mais si la cellule de destination est dans un autre classeur, il faut préciser ce classeur :

cel.Copy Workbooks("toto").Sheets(...).Range(...)

A+

br44 · 26 Novembre 2009

Re : Traduire en VBA

Bonsoir Job75,le forum

Merci pour ces réponses et désolé pour le manque de clarté. je teste dés que possible et vous tiens au courant . Merci encore et à bientôt sur le forum.amicalement Br44

br44 · 18 Décembre 2009

Re : Traduire en VBA

Bonsoir Job75 ,le forum

Se petit message pour vous donnée des nouvelles de ma situation . Suite à des modification au niveau de mon usf j'ai été obliger de revoir certain éléments .

Après avoir essayer d'adapter vôtres dernière proposition qui fut un échec j'ai utiliser l'enregistreur de macro pour voir se que cela donne .

Voici le résultat :

Code:

Sub Macro4()
'
' Macro4 Macro
' Macro enregistrée le 18/12/2009 par RIMMELÉ BRUNO
'

'
    Range("H12:O16").Select
    Selection.Copy
    Sheets("RECAP IMPAYER").Select
    Range("B12").Select
    Selection.PasteSpecial Paste:=[COLOR="Blue"]xlPasteValues[/COLOR], Operation:=[COLOR="Blue"]xlNone[/COLOR], SkipBlanks _
        :=[COLOR="Blue"]False[/COLOR], Transpose:=[COLOR="Blue"]False[/COLOR]

    Sheets("SAISIE1").Select
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    Range("Q12:X16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("RECAP IMPAYER").Select
    ActiveWindow.SmallScroll ToRight:=6
    Range("P12:W16").Select
    ActiveSheet.Paste
    Sheets("SAISIE1").Select
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 24
    Range("Z12:AG16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("RECAP IMPAYER").Select
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    Range("AD12").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 27
End Sub

Ma question : Je voulais savoir si il est possible de simplifier cette macro et de la modifier avec les critère suivants:

1)que la macro se déclenche à une date précise (aujourd'hui par exemple pour les essais) .

2) que la macro ne sélectionne que les N° de facture en rouge (j'ai pris l'intégralité des N° pour essais)

3)ne copier que les valeurs des cellules .

4) A savoir que cette macro serai déclenchée par le bouton "validation facture en cours".

si vous pouvez m'aider à simplifier en me disant quoi supprimé se serais sympa .

je joint mon fichier (sans la macro ci dessus pour cause de poids du fichier) avec le résultat de la macro et l'usf pour que se soit plus claire .

Vous remerciant par avance et m'excusant du retard mis à redémarrer se fil je vous dis à bientôt . Amicalement BR44

br44 · 20 Décembre 2009

Re : Traduire en VBA

Bonjour Job75,le forum

Se petit message pour vous tenir au courant de ma progression .

1) j'ai réussi à simplifier ma macro et à l'adapter sur un bouton.(ouf😛😛😛😛)

Il ne reste plus maintenant à poser la condition suivante ,et c'est là que je vais avoir besoin de vous .

Voici la condition :

copier que les Facture dont le montant est en rouge et supérieures à 0 à la date du 25/01/09 (mais on prend la date du jour pour les essais)?

ceci pour chacun des bloc de la macro .

Voici ma macro simplifié:

Code:

Private Sub CommandButton2_Click() 'Bouton "ENREGISTRER"
[COLOR="Green"]'Selectionne et copie le premier bloc[/COLOR]

[COLOR="Blue"]With[/COLOR] Sheets("SAISIE1").Range("H12:O16").Copy
[COLOR="Blue"]End With[/COLOR]
[COLOR="Blue"]With[/COLOR] Sheets("RECAP IMPAYER").Range("B12")
     .PasteSpecial Paste:=xlValues
[COLOR="Blue"]End With[/COLOR]

[COLOR="Blue"]With [/COLOR]Sheets("SAISIE1").Range("Q12:X16").Copy
[COLOR="Blue"]End With[/COLOR]
[COLOR="Blue"]With[/COLOR] Sheets("RECAP IMPAYER").Range("P12")
     .PasteSpecial Paste:=xlValues
[COLOR="Blue"]End With[/COLOR]
[COLOR="Blue"]With[/COLOR] Sheets("SAISIE1").Range("Z12:AG16").Copy
[COLOR="Blue"]End With[/COLOR]
[COLOR="Blue"]With [/COLOR]Sheets("RECAP IMPAYER").Range("AD12")
     .PasteSpecial Paste:=xlValues
[COLOR="Blue"]End With
End Sub[[/COLOR]/CODE]

A noter que j'ai placer la macro dans le bouton "enregistrer" au lieu du bouton "Validation facture en cour"  

Vous remerciant par avance je vous dis à plus sur se fil .Amicalement BR 44

Traduire en VBA

br44

XLDnaute Impliqué

job75

XLDnaute Barbatruc

br44

XLDnaute Impliqué

job75

XLDnaute Barbatruc

br44

XLDnaute Impliqué

br44

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

br44

XLDnaute Impliqué

job75

XLDnaute Barbatruc

br44

XLDnaute Impliqué

br44

XLDnaute Impliqué

Pièces jointes

br44

XLDnaute Impliqué

Discussions similaires

Traduire en VBA

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency