Traduire en VBA

[br44]

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]

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 :

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

Dans ce cas lancez cette macro :

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]

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 :

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]

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]

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]

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 :

[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]

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]

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 :

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]

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 :

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

A+

 

[br44]

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:

[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]

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]

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]

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 :

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]

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é:

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