Adapter code VBA pour un besoin précis
Salut le forum
Je cherche de l’aide pour pouvoir copier des données de deux feuilles pour coller sur une autre feuille suivant certaines conditions. Ci-dessous les conditions:
- Si dans la feuille DONNE il y’a le mot PRODUIT dans la cellule B4,
je veux que les informations des cellules B13, B28, B42 de la même feuille (DONNE) soient copiées dans la feuille STATSE. - Il en est de même que les informations des cellules C6, et C7 de la feuille COMPTE.
B42 est à coller dans B11 de la feuille STATSE
B13 est à coller dans C11 de la feuille STATSE
B28 est à coller dans D11 de la feuille STATSE
C6 de la feuille COMPTE est à coller dans E11 de la feuille STATSE
C7 de la feuille COMPTE est à coller dans F11 de la feuille STATSE.
A chaque fois (lorsqu’il y’a un nouveau client) et que la condition est respectée (il y’a le mot PRODUIT dans B4 de la feuille DONNE) que les informations copiées soient collées à la suite de la ligne précédentes.
je pense qu'avec le code ci-dessous, vous pourrez mieux mez comprendre et si possible l'adapter à mon besoin (message ci-dessus).
Je reste à votre disposition pour plus d'informations.
Sub Macro10()
'D13, B13, B28, B42 et E17 ne sont pas vide, que ces cellules soient copiées et collées sur la feuille ETAT.
Dim b, C, d, e, f As String
'selection de la feuille de saisie
Sheets("DONNE").Select
'verification des cellules à copier
If Range("D13").Value = "" Then
MsgBox ("D13 est vide")
ElseIf Range("B13").Value = "" Then
MsgBox ("B13 est vide")
ElseIf Range("B28").Value = "" Then
MsgBox ("B28 est vide")
ElseIf Range("B42").Value = "" Then
MsgBox ("B42 est vide")
ElseIf Range("E17").Value = "" Then
MsgBox ("E17 est vide")
ElseIf Application.WorksheetFunction.CountIf(Sheets("ETAT").Range("C5:C" & Sheets("ETAT").Range("C65536").End(xlUp).Row), Range("B41").Value) > 0 Then
MsgBox ("Ce compte est déjà présent dans la feuille ETAT")
Else
'copie des cellules
b = Range("E17").Value 'nom_prenom
C = Range("D13").Value 'D13
d = Range("b28").Value 'téléphone
e = Range("B13").Value 'n° compte
f = Range("B42").Value 'date
'selection de la feuille de destination
Sheets("ETAT").Select
'selection de la première cellule de destination
Range("B5").Select
'vérification de la cellule de destination
If ActiveCell.Value = "" Then 'si la cellule est vide, on colle
ActiveCell = b
ActiveCell.Offset(0, 1) = f
ActiveCell.Offset(0, 2) = e
ActiveCell.Offset(0, 3) = d
ActiveCell.Offset(0, 4) = C
Sheets("DONNE").Select
Range("D3").Select
Exit Sub
Else 'la cellule n'est pas vide
'on boucle tant que la cellule de destination n'est pas vide
Do While ActiveCell.Value <> ""
'selection de la cellule du dessous
ActiveCell.Offset(1, 0).Select
'si la cellule est vide, on colle
If ActiveCell.Value = "" Then
ActiveCell = b
ActiveCell.Offset(0, 1) = f
ActiveCell.Offset(0, 2) = e
ActiveCell.Offset(0, 3) = d
ActiveCell.Offset(0, 4) = C
Sheets("DONNE").Select
Range("D3").Select
Exit Sub
Else
'selection de la cellule du dessous
ActiveCell.Offset(1, 0).Select
End If
Loop 'on boucle tant que la cellule n'est pas vide
End If
'si la cellule est vide, fin de la boucle, et on colle
ActiveCell = b
ActiveCell.Offset(0, 1) = f
ActiveCell.Offset(0, 2) = e
ActiveCell.Offset(0, 3) = d
ActiveCell.Offset(0, 4) = C
Sheets("DONNE").Select
Range("D3").Select
End If
End SubMerci pour le feedback rapide.
il sera bien que la copie se réalise après b42 car après B4 les cellules ne sont pas encore renseignées donc ca va copier du vide.
Aussi permettez que je complète une information.
Je doit éditer les élements copiés de la feuille STATSE en fin de soiré pour un autre service.
Par jour je peut ouvrir des comptes à 10, 20 ou 30 clients.
Serait-il possible de faire en sorte qu'à la fin de la soirée (18h) les lignes vides soient supprimées?
Je pars sur la base d'un total de 35 lignes.
pouvez-vous revoir cela?
Bonjour
zombe a écrit :il sera bien que la copie se réalise après b42 car après B4 les cellules ne sont pas encore renseignées donc ca va copier du vide.
Non car en principe si ces cellules sont vides on le signale et on ne copie pas
zombe a écrit :Serait-il possible de faire en sorte qu'à la fin de la soirée (18h) les lignes vides soient supprimées?
Comment ça, car en supprimant des lignes vides on obtient des lignes .....vides
A moins que tu veux dire qu'il faut masquer les lignes ?
Il faut dire dans quelle zone de la 1ère ligne vide jusqu'à ??????? (à toi de marquer=
Prépares un exemple, cela sera plus simple
Salut BANZAI64
merci pour le feedback.
Banzai64 a écrit :Non car en principe si ces cellules sont vides on le signale et on ne copie pas
Au depart toutes le cellules sont vide.
Je commence par choisir le type de produit avant de renseigner les autres cellules.
Vous comprenez qu'il n'y aura jamais de copie car les celliules à copier seront toujours vides.
Je veux que la copie ait lieu à partir de la dernière cellule renseignée (B42).
zombe a écrit :Comment ça, car en supprimant des lignes vides on obtient des lignes .....vides
puisque la feuille STATSE est un tableau à 36 lignes (plage A11:F36).
si par exemple le tableau n'est pas entièrement rempli, cela suppose qu'il y'a des lignes vides.
Ex: j'ai ouvert 10 comptes à des clients; cela suppose que le tableau (plage A11:F36) ne sera pas complètement occupé.
Il y'aura des lignes vides dans le tableau (A21:F36).
Comment faire pour que ces lignes vides soient supprimées automatiquement à partir de 18h de la journée (lundi au vendredi) et 13h pour le samedi?
Je reste disponible au cas ou.
Tu est bon.
Je te remercie vraiment pour ce que t'a fais.
J'ai vue que y'avais ce code dans une feuille :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B42"), Target) Is Nothing And Target.Count = 1 Then
If Target = "" Then Exit Sub
If InStr(1, UCase(Range("B4")), "PRODUIT") > 0 Then
Copie
End If
End If
End SubJ'ai égalemnt le code ci-dessous:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie
Dim P As Integer
On Error GoTo fin
If Not Intersect(Range("B11,B10,B30,b33,B34"), Target) Is Nothing Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
P = InStr(Target, ValSaisie)
If P > 0 Then
Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
If Right(Target, 1) = "--" Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & "--" & ValSaisie
End If
End If
Else: GoTo fin
End If
fin:
Application.EnableEvents = True ' Dans tous les cas on remet les évènements en service
Exit Sub
End SubJe vais vous demander de m'aider à les fondre sans que ca ne joue pas sur la qualité des codes.
J'ai pu tester votre fichier joint et c'est super.
Aussi, à quel moment il y'aura les lignes seront masquées?
Bonjour
Je n'ai fait aucun test (je n'ai pas le fichier)
zombe a écrit :Aussi, à quel moment il y'aura les lignes seront masquées?
Regardes dans le module ThisWorkbook
Merci pour la fusion que ta réalisé.
J'ai essayé de l'exploiter et souhaiterai avoir ton appreciation?
Ci-dessous le code complet.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie
Dim P As Integer
If Not Intersect(Range("B42"), Target) Is Nothing And Target.Count = 1 Then
If Target = "" Then Exit Sub
If InStr(1, UCase(Range("B4")), "PACK") > 0 Then
Call Copie
End If
ElseIf Not Intersect(Range("B11,B10,B30,b33,B34"), Target) Is Nothing Then
On Error GoTo fin
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
P = InStr(Target, ValSaisie)
If P > 0 Then
Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
If Right(Target, 1) = "--" Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & "--" & ValSaisie
End If
End If
End If
Application.EnableEvents = True
ElseIf Range("B4").Value = "COMPTE CHEQUE PARTICULIERS" Then
If Target.Address = "$B$5" And Target.Value <> "" Then
Range("B7").Select
ElseIf Target.Address = "$B$31" And Target.Value <> "" Then
Range("B33").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B39").Select
ElseIf Target.Address = "$B$39" And Target.Value <> "" Then
Range("B42").Select
Call Macro1
MsgBox ("Remettre la copie en impression au client pour vérification et renseigner IGOR avant de continuer")
Range("B42").Select
ElseIf Target.Address = "$B$42" And Target.Value <> "" Then
Range("B44").Select
ElseIf Target.Address = "$B$44" And Target.Value <> "" Then
Range("B48").Select
ElseIf Target.Address = "$B$48" And Target.Value <> "" Then
Range("B49").Select
Call Macro10
'Range("d3").Select
Range("d3").Select
Else: GoTo fin
End If
ElseIf Target.Address = "$B$46" And Target.Value <> "" Then
Call Macro10
GoTo fin
Else: GoTo fin
End If
fin:
Application.EnableEvents = True ' Dans tous les cas on remet les évènements en service
End SubBonsoir
Travailler sans filet pas évident, comme je ne sais pas trop ce que tu cherches à faire
je te propose cette macro : Impérativement à tester
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie
Dim P As Integer
If Not Intersect(Range("B42"), Target) Is Nothing And Target.Count = 1 Then
If Target = "" Then Exit Sub
If InStr(1, UCase(Range("B4")), "PACK") > 0 Then
Call Copie
End If
ElseIf Not Intersect(Range("B11,B10,B30,b33,B34"), Target) Is Nothing Then
On Error GoTo fin
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
P = InStr(Target, ValSaisie)
If P > 0 Then
Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
If Right(Target, 1) = "--" Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & "--" & ValSaisie
End If
End If
' Application.EnableEvents = True
ElseIf Range("B4").Value = "COMPTE CHEQUE PARTICULIERS" Then
If Target.Address = "$B$5" And Target.Value <> "" Then
Range("B7").Select
ElseIf Target.Address = "$B$31" And Target.Value <> "" Then
Range("B33").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B39").Select
ElseIf Target.Address = "$B$39" And Target.Value <> "" Then
Range("B42").Select
Call Macro1
MsgBox ("Remettre la copie en impression au client pour vérification et renseigner IGOR avant de continuer")
Range("B42").Select
ElseIf Target.Address = "$B$42" And Target.Value <> "" Then
Range("B44").Select
ElseIf Target.Address = "$B$44" And Target.Value <> "" Then
Range("B48").Select
ElseIf Target.Address = "$B$48" And Target.Value <> "" Then
Range("B49").Select
Call Macro10
Range("d3").Select
' Else
' GoTo fin
' End If
ElseIf Target.Address = "$B$46" And Target.Value <> "" Then
Call Macro10
' GoTo fin
' Else: GoTo fin
End If
End If
fin:
Application.EnableEvents = True ' Dans tous les cas on remet les évènements en service
End SubPour faciliter les choses j'ai joint le fichier avec tes codes adaptés pour le teste (feuille, thisworkbook et module).
J'ai fais mais ca n'a pas fonctionné comme souhaité.
Je te laisse le soins de bien l'apprecier.
je profite te donner le role des macros fusionnées:
- il y'a une macro qui permet de gerer les mouvements du curseur,
- une 2è macro qui permet dans une liste deroulante de pouvoir choisir 2 élements
- la 3è macro est celle que tu viens de faire pour permettre la copie des données définies.
Bonsoir
zombe a écrit :J'ai fais mais ca n'a pas fonctionné comme souhaité.
Il faut en dire un peu plus
La recopie ?????
Les déplacements ?????
Les liste déroulantes ?????
Les listes déroulantes où sont elles ?
Une erreur pour la gestion des déplacements
Il faut un S à PRODUIT
ElseIf Range("B4").Value = "PRODUITS A" Thenla recopie fonctionne
C'est vrai que j'ai fais de liste deroulante mais mon fichier principal il y'a des liste deroulante.
Ce que vous avez fait n'a pas eu de conséquence sur cette macro. elle fonctionne toujours bien.
C'est vous qui me l'avez fabriquée.
la ou jai des soucis, c'est les 2 autre macros (copié et deplacement du curseur).
La macro deplacement du curseur me permet suivant certaines conditions definie que le curseur saute une cellule oub passe à la cellule suivante. voici un exemple de code:
ElseIf Range("B4").Value = "COMPTE CHEQUE PARTICULIERS" Then
If Target.Address = "$B$5" And Target.Value <> "" Then
Range("B7").Select
ElseIf Target.Address = "$B$31" And Target.Value <> "" Then
Range("B33").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B39").Select
ElseIf Target.Address = "$B$39" And Target.Value <> "" Then
Range("B42").Select
Call Macro1
MsgBox ("Remettre la copie en impression au client pour vérification et renseigner IGOR avant de continuer")
Range("B42").Select
ElseIf Target.Address = "$B$42" And Target.Value <> "" Then
Range("B44").Select
ElseIf Target.Address = "$B$44" And Target.Value <> "" Then
Range("B48").Select
ElseIf Target.Address = "$B$48" And Target.Value <> "" Then
Range("B49").Select
Call Macro10
Range("d3").Select
' Else
' GoTo fin
' End If
'GESTION DU CURSEUR SUR COMPTE PACK SALARIA PUBLIQUE
ElseIf Range("B4").Value = "PACK SALARIA PUBLIQUE" Then
If Target.Address = "$B$5" And Target.Value <> "" Then
Range("B7").Select
Call Imprimer_PS
MsgBox ("FAIRE SIGNER L'ASSURANCE COLINA ET LES CONDITIONS GENERALES EN IMPRESSION AVANT DE CONTINUER SVP!")
ElseIf Target.Address = "$B$41" And Target.Value <> "" Then
Range("B42").Select
Call Macro1
MsgBox ("Remettre la copie en impression au client pour vérification et renseigner IGOR avant de continuer")
Range("B42").Select
ElseIf Target.Address = "$B$42" And Target.Value <> "" Then
Range("B44").Select
ElseIf Target.Address = "$B$44" And Target.Value <> "" Then
Range("B46").Select
ElseIf Target.Address = "$B$48" And Target.Value <> "" Then
Range("B49").Select
Call Macro10
'Range("d3").Select
Range("d3").Select
'Else: GoTo fin
End If
la macro copie est celle sur laquelle nous avons commencé.
Elle permet de copier des données d'une feuille ou deux feuilles pour les coller sur une autre feuille.
Voici grosso modo ce que je peux dire mais toujours disponible pour des complements d'informations afin que vous puissiez m'aider.
Bonsoir
Comme je t'ai dit
La partie copie fonctionne
La partie que tu as mise dans le fichier pour les déplacements fonctionne si tu rajoutes un S à PRODUIT
Je ne vois pas où il y a des problèmes
Bien sur je n'ai pas tout testé
C'est à toi de me dire si on fait ça et ça et ça alors on a ça mais on devrait avoir ça
Je ne connais pas ton programme comme toi tu le connais
Merci pour ta franchise.
je vais essayer de voire ce qui cloche pour te revenir mais avant que signifie les expressions goto:fin, Else goto et à quel moment les utilise t'on?
merci
Bonsoir
Goto signifie va à ....
C'est une instruction de branchement simple, lorsque l'interpréteur rencontre cette instruction, il continu l'interprétation du code à partir du nom (étiquette) qui est associé à l'instruction Goto
Merci pour ta réponse.
Toujour pour bien comprendre les goto.
Je vois que dans la refonte du code que je vous ai envoyé, vous avez enlevé les goto (voir code) et end if
ElseIf Range("B4").Value = "PACK MON" Then
If Target.Address = "$B$5" And Target.Value <> "" Then
Range("B7").Select
MsgBox ("FAIRE SIGNER L'ASSURANCE COLINA ET LES CONDITIONS GENERALES AVANT DE CONTINUER SVP!")
ElseIf Target.Address = "$B$31" And Target.Value <> "" Then
Range("B33").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B39").Select
ElseIf Target.Address = "$B$39" And Target.Value <> "" Then
Range("B42").Select
Call Macro1
MsgBox ("Remettre la copie en impression au client pour vérification et renseigner IGOR avant de continuer")
Range("B42").Select
ElseIf Target.Address = "$B$42" And Target.Value <> "" Then
Range("B44").Select
ElseIf Target.Address = "$B$44" And Target.Value <> "" Then
Range("B46").Select
ElseIf Target.Address = "$B$47" And Target.Value <> "" Then
Range("B48").Select
Call Macro10
'Range("d3").Select
Range("d3").Select
'Else: GoTo fin
'End Ifpourtant la macro initiale comportait ces instructions et ca marchais bien.
Y'a t-il une difference entre les 2 "codes"
ElseIf Range("B4").Value = "PACK MON BUSINESS" Then
If Target.Address = "$B$5" And Target.Value <> "" Then
Range("B7").Select
MsgBox ("FAIRE SIGNER L'ASSURANCE COLINA ET LES CONDITIONS GENERALES AVANT DE CONTINUER SVP!")
ElseIf Target.Address = "$B$31" And Target.Value <> "" Then
Range("B33").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B39").Select
ElseIf Target.Address = "$B$39" And Target.Value <> "" Then
Range("B42").Select
Call Macro1
MsgBox ("Remettre la copie en impression au client pour vérification et renseigner IGOR avant de continuer")
Range("B42").Select
ElseIf Target.Address = "$B$42" And Target.Value <> "" Then
Range("B44").Select
ElseIf Target.Address = "$B$44" And Target.Value <> "" Then
Range("B46").Select
ElseIf Target.Address = "$B$47" And Target.Value <> "" Then
Range("B48").Select
Call Macro10
'Range("d3").Select
Range("d3").Select
Else: GoTo fin
End IfBonjour
Le déroulement de la macro
Sans les modifications
Si aucune conditions n'est trouvée elle va se trouer au Else ---> Goto Fin ----> End If ---> Fin: --->Application...... ----> End Sub
Après les modifications
Si aucune conditions n'est trouvée elle va se trouer au End If --->Application........ ---> End Sub
Donc on gagne dans ce cas la une meilleure lisibilité du code
Salut Banzaï64
Comme la refonte me cause de soucis, je vais maintenir mon ancien code comme tel et coller la macro qui gère les copies sur une autre feuille. Je vais passer par des formules simples pour tranferer les éléments à copier sur une feuille que je vais créer. Maintenant à partir de cette feuille je vais utiliser la macro initiales (sans la refonte) que vous avez créee.
Je teste cela et vous reviens.
Salut Banzaï64
je pense que cette fois ci on pourra en finir avec ce que je cherche.
Ca n'a pas bien fonctionné mais je sais que vous saurai de quoi il souffre.
Je souhaiterai apporter des modifications au niveau des conditions: je veux maintenant que si la 1ère lettre de A105 = par P ou si dans A106 il y'a SESAME, que les éléments à copier se réalisent.Merci de l'adapter pour moi.
En resumé, voici les differentes macros que contient le fichier:
- dans la feuille PARAMETRE, il y'a la macro PRIVATE sub qui permet d'appeler la macro copie du module 1.
- dans thisworkbook j'ai deux macros:une qui permet l'envoi de mail et l'autre le masque de lignes (qui vient de vous)
- le module 1 contient la macro copie