Excel/MACRO copier/coller entre feuilles
Résolu/Fermé
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
-
13 oct. 2009 à 14:37
informatifien Messages postés 741 Date d'inscription lundi 18 mai 2009 Statut Membre Dernière intervention 10 janvier 2016 - 15 oct. 2009 à 10:45
informatifien Messages postés 741 Date d'inscription lundi 18 mai 2009 Statut Membre Dernière intervention 10 janvier 2016 - 15 oct. 2009 à 10:45
A voir également:
- Excel/MACRO copier/coller entre feuilles
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Copier coller pdf - Guide
- Historique copier-coller android - Guide
- Symbole clavier copier coller - Guide
10 réponses
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
13 oct. 2009 à 15:13
13 oct. 2009 à 15:13
je viens de faire des essais et je progresse enfin l'erreur est de plus en plus proche du end sub lol voici le nouvo code:
Private Sub crea_Click()
Dim a As Integer
Dim b As Long
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
Dim x As Integer
b = numof_crea
a = 0
Do
a = a + 1
Loop Until Application.Cells(a, 1) = b
Cells(a, 1).Value = b
Cells(a + 1, 1).Value = b
Cells(a + 2, 1).Value = b
Cells(a, 2).Value = codearticle
Cells(a + 1, 2).Value = codearticle
Cells(a + 2, 2).Value = codearticle
Cells(a, 3).Value = datedepose
Cells(a, 4).Value = dateretour
Cells(a, 4).Select
depose = datedepose
retour = dateretour
nbjours = retour - depose
ActiveCell.Offset(0, 1) = depose
For x = 1 To nbjours
datesuite = CDate(Cells(a, x + 4).Value) + 1 ' je te conseille de partir du début de la ligne Axx : sur cette ligne tu as écrit 5 infos et c'est cette dernière infos que tu récupères
Cells(a, x + 5).Value = datesuite ' les dates sont en lignes... donc ici x+5 pour avoir le dernier
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x))
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Worksheets("CODES ARTICLES").Select ‘je selectionne un onglet
Dim d As Long ‘ je declare la variable de codearticle une combobox
d = codearticle
Dim c As Integer ‘ je fais une boucle sur ma 2° colonne jusqu’à la valeur b (codearticle)
c = 1
Do
c = c + 1
Loop Until Application.Cells(c, 1) = d
ActiveCell.EntireRow.Select ‘ je copy la ligne sur la quel ma boucle s’arête
Selection.Copy ‘ je re selectionne la feuille ou j’était
Dim e As Integer ‘ je boucle à nouveau pour trouver codearticle dans la feuille dans la quel je suis revenue = 0
Do
e = e + 1
Loop Until Application.Cells(e, 1) = b
ActiveSheet.Paste Destination:=ActiveSheet.Range("E", e + 1) ‘ je colle la ligne à partir de la colonne E 1 ligne en dessous de là ou s’est arrêtée la boucle
Exit Sub
Unload Creasupp
End Sub
Donc maintenant l'erreur se met sur ActiveSheet.Paste Destination:=ActiveSheet.Range("E",e+1)
l'erreur dit: erreur définie par l'application ou par l'objet . . .
Un peu d'aide s'il vous plait . . .
Private Sub crea_Click()
Dim a As Integer
Dim b As Long
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
Dim x As Integer
b = numof_crea
a = 0
Do
a = a + 1
Loop Until Application.Cells(a, 1) = b
Cells(a, 1).Value = b
Cells(a + 1, 1).Value = b
Cells(a + 2, 1).Value = b
Cells(a, 2).Value = codearticle
Cells(a + 1, 2).Value = codearticle
Cells(a + 2, 2).Value = codearticle
Cells(a, 3).Value = datedepose
Cells(a, 4).Value = dateretour
Cells(a, 4).Select
depose = datedepose
retour = dateretour
nbjours = retour - depose
ActiveCell.Offset(0, 1) = depose
For x = 1 To nbjours
datesuite = CDate(Cells(a, x + 4).Value) + 1 ' je te conseille de partir du début de la ligne Axx : sur cette ligne tu as écrit 5 infos et c'est cette dernière infos que tu récupères
Cells(a, x + 5).Value = datesuite ' les dates sont en lignes... donc ici x+5 pour avoir le dernier
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x))
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Worksheets("CODES ARTICLES").Select ‘je selectionne un onglet
Dim d As Long ‘ je declare la variable de codearticle une combobox
d = codearticle
Dim c As Integer ‘ je fais une boucle sur ma 2° colonne jusqu’à la valeur b (codearticle)
c = 1
Do
c = c + 1
Loop Until Application.Cells(c, 1) = d
ActiveCell.EntireRow.Select ‘ je copy la ligne sur la quel ma boucle s’arête
Selection.Copy ‘ je re selectionne la feuille ou j’était
Dim e As Integer ‘ je boucle à nouveau pour trouver codearticle dans la feuille dans la quel je suis revenue = 0
Do
e = e + 1
Loop Until Application.Cells(e, 1) = b
ActiveSheet.Paste Destination:=ActiveSheet.Range("E", e + 1) ‘ je colle la ligne à partir de la colonne E 1 ligne en dessous de là ou s’est arrêtée la boucle
Exit Sub
Unload Creasupp
End Sub
Donc maintenant l'erreur se met sur ActiveSheet.Paste Destination:=ActiveSheet.Range("E",e+1)
l'erreur dit: erreur définie par l'application ou par l'objet . . .
Un peu d'aide s'il vous plait . . .
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 311
13 oct. 2009 à 18:17
13 oct. 2009 à 18:17
Bonjour au lieu de:
c = 1
Do
je n'ai pas compris :je fais une boucle sur ma 2° colonne jusqu’à la valeur b (codearticle) avec
Loop Until Application.Cells(c, 1) = d Donc remets à la bonne place -je ne connais pas le programme- b et d
Essaies
normalement, il est d'usage de grouper les déclarations de variables juste sous le nom de la la macro pour faciliter la maintenance par ex:
Enfin, tu gagneras un temps fou en placant au départ l'instruction
application.screenupdating=False
qui fige le défilement de l'écran
c = 1
Do
c = c + 1 Loop Until Application.Cells(c, 2) = d Worksheets("CODES ARTICLES").Row.Copy ‘ Do e = e + 1 Loop Until Application.Cells(e, 2) = d Worksheets("SUIVI DES OF").Paste Destination:=Worksheets("SUIVI DES OF").Range("E", e + 1) '
je n'ai pas compris :je fais une boucle sur ma 2° colonne jusqu’à la valeur b (codearticle) avec
Loop Until Application.Cells(c, 1) = d Donc remets à la bonne place -je ne connais pas le programme- b et d
Essaies
With Worksheets("CODES ARTICLES") c = .Columns(2).Find(d, .Range("B65536"), xlValues).Row 'b? tampon = .Rows(c).Value End With With Worksheets("SUIVI DES OF") e = .Columns(2).Find(d, .Range("B65536"), xlValues).Row+1 'd ? Rows(e) = tampon End With
normalement, il est d'usage de grouper les déclarations de variables juste sous le nom de la la macro pour faciliter la maintenance par ex:
sub ta macro() dim b as long,c as integer, d as long, e as integer dim tampon
Enfin, tu gagneras un temps fou en placant au départ l'instruction
application.screenupdating=False
qui fige le défilement de l'écran
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 311
13 oct. 2009 à 18:24
13 oct. 2009 à 18:24
ci joint tite démo sur la partie étudiée
https://www.cjoint.com/?knsxx78i1L
https://www.cjoint.com/?knsxx78i1L
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
14 oct. 2009 à 08:44
14 oct. 2009 à 08:44
re bon merci pour ton code que je viens de trouver mais j'ai réussi hier soir à le faire marcher je le colle ça pourra servir mais ej vais essayer de declarer toutes mes variable sur tes conseils et voir si ca foncitonne toujours:
Private Sub crea_Click()
Dim a As Integer
Dim b As Long
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
Dim x As Integer
b = numof_crea
a = 0
Do
a = a + 1
Loop Until Application.Cells(a, 1) = Empty ' je cherche la 1ere cell vide dans la colo A
Cells(a, 1).Value = b ' j'inscris la valeur de b dans la 1ere cell vide de la colo A
Cells(a + 1, 1).Value = b ' puis dans la 2°
Cells(a + 2, 1).Value = b ' puis la 3°
Cells(a, 2).Value = codearticle ' j'inscris la valeur codearticle dans la 1ere cell vide de la colo B
Cells(a + 1, 2).Value = codearticle ' puis dans la 2°
Cells(a + 2, 2).Value = codearticle ' puis la 3°
Cells(a, 3).Value = datedepose ' j'inscris la valeur datedepose dans la 1ere cell vide de la colo B
Cells(a, 4).Value = dateretour ' j'inscris la valeur dateretour dans la 1ere cell vide de la colo B
Cells(a, 4).Select ' je séléctionne la cell A4
depose = datedepose
retour = dateretour
nbjours = retour - depose ' je compte le nbre de jours entre datedepose et dateretour
ActiveCell.Offset(0, 1) = depose ' j'inscris la valeur depose dans la colo C (5°) de la meme ligne
For x = 1 To nbjours ' j'inscris les jours les uns à la suite des autres
datesuite = CDate(Cells(a, x + 4).Value) + 1
Cells(a, x + 5).Value = datesuite
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Sheets("CODES ARTICLES").Select ' je séléctionne ma feuille ou sont mes code article
Dim d As Long
d = codearticle
Dim c As Integer ' je cherche mon code article
c = 0
Do
c = c + 1
Loop Until Application.Cells(c, 1) = d
Dim i As Integer ' je cherche la derniere cell de mon code article (horizontalement)
Do
i = i + 1
Loop Until Application.Cells(c, i) = Empty
Range(Application.Cells(c, 2), Application.Cells(c, i)).Select ' je selectionne ma plage de cells de la 2° colo jusqu'à la premiere vide
Selection.Copy ' je copie ma selection
Sheets("SUIVI DES OF").Select ' je selectionne ma feuille de synthèse
Dim e As Integer ' je cherche la ligne créer avec les dates mais par son numero d'OF
e = 0
Do
e = e + 1
Loop Until Application.Cells(e, 1) = b
Application.Cells(e + 1, 5).Select ' je selectionne la cellule en dessous de la 1ere date
ActiveSheet.Paste ' je colle mon code article
Application.Cells(e + 2, 5).Select ' je selectionne la cellule en dessous de la 1ere copie
ActiveSheet.Paste ' je colle mon code article une 2° fois
Unload Creasupp
End Sub
Voilà et euuh ben j'ai pas trop compris ce que tu n'as pas compris et je ne peux pas aller sur cjoint sur le poste ou je suis là. . .. par contre j'ai une question: au niveau du formatage des dates y-a-t'il un moyen pour que formater différement les samedi est dimanche? si oui lequel???
Merci
Private Sub crea_Click()
Dim a As Integer
Dim b As Long
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
Dim x As Integer
b = numof_crea
a = 0
Do
a = a + 1
Loop Until Application.Cells(a, 1) = Empty ' je cherche la 1ere cell vide dans la colo A
Cells(a, 1).Value = b ' j'inscris la valeur de b dans la 1ere cell vide de la colo A
Cells(a + 1, 1).Value = b ' puis dans la 2°
Cells(a + 2, 1).Value = b ' puis la 3°
Cells(a, 2).Value = codearticle ' j'inscris la valeur codearticle dans la 1ere cell vide de la colo B
Cells(a + 1, 2).Value = codearticle ' puis dans la 2°
Cells(a + 2, 2).Value = codearticle ' puis la 3°
Cells(a, 3).Value = datedepose ' j'inscris la valeur datedepose dans la 1ere cell vide de la colo B
Cells(a, 4).Value = dateretour ' j'inscris la valeur dateretour dans la 1ere cell vide de la colo B
Cells(a, 4).Select ' je séléctionne la cell A4
depose = datedepose
retour = dateretour
nbjours = retour - depose ' je compte le nbre de jours entre datedepose et dateretour
ActiveCell.Offset(0, 1) = depose ' j'inscris la valeur depose dans la colo C (5°) de la meme ligne
For x = 1 To nbjours ' j'inscris les jours les uns à la suite des autres
datesuite = CDate(Cells(a, x + 4).Value) + 1
Cells(a, x + 5).Value = datesuite
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Sheets("CODES ARTICLES").Select ' je séléctionne ma feuille ou sont mes code article
Dim d As Long
d = codearticle
Dim c As Integer ' je cherche mon code article
c = 0
Do
c = c + 1
Loop Until Application.Cells(c, 1) = d
Dim i As Integer ' je cherche la derniere cell de mon code article (horizontalement)
Do
i = i + 1
Loop Until Application.Cells(c, i) = Empty
Range(Application.Cells(c, 2), Application.Cells(c, i)).Select ' je selectionne ma plage de cells de la 2° colo jusqu'à la premiere vide
Selection.Copy ' je copie ma selection
Sheets("SUIVI DES OF").Select ' je selectionne ma feuille de synthèse
Dim e As Integer ' je cherche la ligne créer avec les dates mais par son numero d'OF
e = 0
Do
e = e + 1
Loop Until Application.Cells(e, 1) = b
Application.Cells(e + 1, 5).Select ' je selectionne la cellule en dessous de la 1ere date
ActiveSheet.Paste ' je colle mon code article
Application.Cells(e + 2, 5).Select ' je selectionne la cellule en dessous de la 1ere copie
ActiveSheet.Paste ' je colle mon code article une 2° fois
Unload Creasupp
End Sub
Voilà et euuh ben j'ai pas trop compris ce que tu n'as pas compris et je ne peux pas aller sur cjoint sur le poste ou je suis là. . .. par contre j'ai une question: au niveau du formatage des dates y-a-t'il un moyen pour que formater différement les samedi est dimanche? si oui lequel???
Merci
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
14 oct. 2009 à 08:44
14 oct. 2009 à 08:44
re bon merci pour ton code que je viens de trouver mais j'ai réussi hier soir à le faire marcher je le colle ça pourra servir mais ej vais essayer de declarer toutes mes variable sur tes conseils et voir si ca foncitonne toujours:
Private Sub crea_Click()
Dim a As Integer
Dim b As Long
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
Dim x As Integer
b = numof_crea
a = 0
Do
a = a + 1
Loop Until Application.Cells(a, 1) = Empty ' je cherche la 1ere cell vide dans la colo A
Cells(a, 1).Value = b ' j'inscris la valeur de b dans la 1ere cell vide de la colo A
Cells(a + 1, 1).Value = b ' puis dans la 2°
Cells(a + 2, 1).Value = b ' puis la 3°
Cells(a, 2).Value = codearticle ' j'inscris la valeur codearticle dans la 1ere cell vide de la colo B
Cells(a + 1, 2).Value = codearticle ' puis dans la 2°
Cells(a + 2, 2).Value = codearticle ' puis la 3°
Cells(a, 3).Value = datedepose ' j'inscris la valeur datedepose dans la 1ere cell vide de la colo B
Cells(a, 4).Value = dateretour ' j'inscris la valeur dateretour dans la 1ere cell vide de la colo B
Cells(a, 4).Select ' je séléctionne la cell A4
depose = datedepose
retour = dateretour
nbjours = retour - depose ' je compte le nbre de jours entre datedepose et dateretour
ActiveCell.Offset(0, 1) = depose ' j'inscris la valeur depose dans la colo C (5°) de la meme ligne
For x = 1 To nbjours ' j'inscris les jours les uns à la suite des autres
datesuite = CDate(Cells(a, x + 4).Value) + 1
Cells(a, x + 5).Value = datesuite
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Sheets("CODES ARTICLES").Select ' je séléctionne ma feuille ou sont mes code article
Dim d As Long
d = codearticle
Dim c As Integer ' je cherche mon code article
c = 0
Do
c = c + 1
Loop Until Application.Cells(c, 1) = d
Dim i As Integer ' je cherche la derniere cell de mon code article (horizontalement)
Do
i = i + 1
Loop Until Application.Cells(c, i) = Empty
Range(Application.Cells(c, 2), Application.Cells(c, i)).Select ' je selectionne ma plage de cells de la 2° colo jusqu'à la premiere vide
Selection.Copy ' je copie ma selection
Sheets("SUIVI DES OF").Select ' je selectionne ma feuille de synthèse
Dim e As Integer ' je cherche la ligne créer avec les dates mais par son numero d'OF
e = 0
Do
e = e + 1
Loop Until Application.Cells(e, 1) = b
Application.Cells(e + 1, 5).Select ' je selectionne la cellule en dessous de la 1ere date
ActiveSheet.Paste ' je colle mon code article
Application.Cells(e + 2, 5).Select ' je selectionne la cellule en dessous de la 1ere copie
ActiveSheet.Paste ' je colle mon code article une 2° fois
Unload Creasupp
End Sub
Voilà et euuh ben j'ai pas trop compris ce que tu n'as pas compris et je ne peux pas aller sur cjoint sur le poste ou je suis là. . .. par contre j'ai une question: au niveau du formatage des dates y-a-t'il un moyen pour que formater différement les samedi est dimanche? si oui lequel???
Merci
Private Sub crea_Click()
Dim a As Integer
Dim b As Long
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
Dim x As Integer
b = numof_crea
a = 0
Do
a = a + 1
Loop Until Application.Cells(a, 1) = Empty ' je cherche la 1ere cell vide dans la colo A
Cells(a, 1).Value = b ' j'inscris la valeur de b dans la 1ere cell vide de la colo A
Cells(a + 1, 1).Value = b ' puis dans la 2°
Cells(a + 2, 1).Value = b ' puis la 3°
Cells(a, 2).Value = codearticle ' j'inscris la valeur codearticle dans la 1ere cell vide de la colo B
Cells(a + 1, 2).Value = codearticle ' puis dans la 2°
Cells(a + 2, 2).Value = codearticle ' puis la 3°
Cells(a, 3).Value = datedepose ' j'inscris la valeur datedepose dans la 1ere cell vide de la colo B
Cells(a, 4).Value = dateretour ' j'inscris la valeur dateretour dans la 1ere cell vide de la colo B
Cells(a, 4).Select ' je séléctionne la cell A4
depose = datedepose
retour = dateretour
nbjours = retour - depose ' je compte le nbre de jours entre datedepose et dateretour
ActiveCell.Offset(0, 1) = depose ' j'inscris la valeur depose dans la colo C (5°) de la meme ligne
For x = 1 To nbjours ' j'inscris les jours les uns à la suite des autres
datesuite = CDate(Cells(a, x + 4).Value) + 1
Cells(a, x + 5).Value = datesuite
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Sheets("CODES ARTICLES").Select ' je séléctionne ma feuille ou sont mes code article
Dim d As Long
d = codearticle
Dim c As Integer ' je cherche mon code article
c = 0
Do
c = c + 1
Loop Until Application.Cells(c, 1) = d
Dim i As Integer ' je cherche la derniere cell de mon code article (horizontalement)
Do
i = i + 1
Loop Until Application.Cells(c, i) = Empty
Range(Application.Cells(c, 2), Application.Cells(c, i)).Select ' je selectionne ma plage de cells de la 2° colo jusqu'à la premiere vide
Selection.Copy ' je copie ma selection
Sheets("SUIVI DES OF").Select ' je selectionne ma feuille de synthèse
Dim e As Integer ' je cherche la ligne créer avec les dates mais par son numero d'OF
e = 0
Do
e = e + 1
Loop Until Application.Cells(e, 1) = b
Application.Cells(e + 1, 5).Select ' je selectionne la cellule en dessous de la 1ere date
ActiveSheet.Paste ' je colle mon code article
Application.Cells(e + 2, 5).Select ' je selectionne la cellule en dessous de la 1ere copie
ActiveSheet.Paste ' je colle mon code article une 2° fois
Unload Creasupp
End Sub
Voilà et euuh ben j'ai pas trop compris ce que tu n'as pas compris et je ne peux pas aller sur cjoint sur le poste ou je suis là. . .. par contre j'ai une question: au niveau du formatage des dates y-a-t'il un moyen pour que formater différement les samedi est dimanche? si oui lequel???
Merci
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 311
14 oct. 2009 à 09:26
14 oct. 2009 à 09:26
Bonjour,
Je viens de regarder ton post: mis à part les déclarations rien de changé!... donc te donner un conseil pour changer les formats suivant le jour, j'hésite (combine if, weekday, avec la propriété font=bold de range)
que les déclarations soient sous le titre ou dans la macro ne change rien au fonctionnement... fais un test en pas à pas, tu verras
Par contre, si tu fais çà au boulot et s'il y a un service informatique tu passeras pour un charlot et ce définitivement: une bonne procédure est celle qui facilite au maximum la maintenance
Je viens de regarder ton post: mis à part les déclarations rien de changé!... donc te donner un conseil pour changer les formats suivant le jour, j'hésite (combine if, weekday, avec la propriété font=bold de range)
que les déclarations soient sous le titre ou dans la macro ne change rien au fonctionnement... fais un test en pas à pas, tu verras
Par contre, si tu fais çà au boulot et s'il y a un service informatique tu passeras pour un charlot et ce définitivement: une bonne procédure est celle qui facilite au maximum la maintenance
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
14 oct. 2009 à 09:41
14 oct. 2009 à 09:41
mais euuuh j'ai changé des truc et puis maintenant ca marche et euuh oui je fais ça au boulot et non il n'y a pas de service informatique sinon ce sont eux qui ferai ça on me fais faire ça par ce que j'ai fais une formation technicien d'assistance en informatique ça n'a rien à voir j'apprend seul le VBA je galère je n'ai aucune base je lis quelque bouquin donc bon faire un code propre quand tu ne sais pas trop par ou attaquer c'est pas facile facile . . . . j'ai rassembler mes variable mais une à posée problème j'ai du la remetre là ou elle été enfin sa valeur du moin c'est le x = 5 voici le code "propre" enfin je pense:
Private Sub crea_Click()
Dim a As Integer, d As Long, b As Long, x As Integer, c As Integer, i As Integer, e As Integer
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
a = 0
b = numof_crea
c = 0
d = codearticle
e = 0
depose = datedepose
retour = dateretour
Do
a = a + 1
Loop Until Application.Cells(a, 1) = Empty ' je cherche la 1ere cell vide dans la colo A
Cells(a, 1).Value = b ' j'inscris la valeur de b dans la 1ere cell vide de la colo A
Cells(a + 1, 1).Value = b ' puis dans la 2°
Cells(a + 2, 1).Value = b ' puis la 3°
Cells(a, 2).Value = codearticle ' j'inscris la valeur codearticle dans la 1ere cell vide de la colo B
Cells(a + 1, 2).Value = codearticle ' puis dans la 2°
Cells(a + 2, 2).Value = codearticle ' puis la 3°
Cells(a, 3).Value = datedepose ' j'inscris la valeur datedepose dans la 1ere cell vide de la colo B
Cells(a, 4).Value = dateretour ' j'inscris la valeur dateretour dans la 1ere cell vide de la colo B
Cells(a, 4).Select ' je séléctionne la cell A4
nbjours = retour - depose ' je compte le nbre de jours entre datedepose et dateretour
ActiveCell.Offset(0, 1) = depose ' j'inscris la valeur depose dans la colo C (5°) de la meem ligne
For x = 1 To nbjours ' j'inscris les jours les uns à la suite des autres
datesuite = CDate(Cells(a, x + 4).Value) + 1
Cells(a, x + 5).Value = datesuite
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Sheets("CODES ARTICLES").Select ' je séléctionne ma feuille ou sont mes code article
Do ' je cherche mon code article
c = c + 1
Loop Until Application.Cells(c, 1) = d
Do ' je cherche la derniere cell de mon code article (horizontalement)
i = i + 1
Loop Until Application.Cells(c, i) = Empty
Range(Application.Cells(c, 2), Application.Cells(c, i)).Select ' je selectionne ma plage de cells de la 2° colo jusqu'à la premiere vide
Selection.Copy ' je copie ma selection
Sheets("SUIVI DES OF").Select ' je selectionne ma feuille de synthèse
Do ' je cherche la ligne créer avec les dates mais par son numero d'OF
e = e + 1
Loop Until Application.Cells(e, 1) = b
Application.Cells(e + 1, 5).Select ' je selectionne la cellule en dessous de la 1ere date
ActiveSheet.Paste ' je colle mon code article
Application.Cells(e + 2, 5).Select ' je selectionne la cellule en dessous de la 1ere copie
ActiveSheet.Paste ' je colle mon code article une 2° fois
Unload Creasupp
End Sub
le If Weekdays je le place dans le code de mise en forme With range ou dans le For Next ?
Private Sub crea_Click()
Dim a As Integer, d As Long, b As Long, x As Integer, c As Integer, i As Integer, e As Integer
Dim datesuite As Date
Dim depose As Date
Dim retour As Date
a = 0
b = numof_crea
c = 0
d = codearticle
e = 0
depose = datedepose
retour = dateretour
Do
a = a + 1
Loop Until Application.Cells(a, 1) = Empty ' je cherche la 1ere cell vide dans la colo A
Cells(a, 1).Value = b ' j'inscris la valeur de b dans la 1ere cell vide de la colo A
Cells(a + 1, 1).Value = b ' puis dans la 2°
Cells(a + 2, 1).Value = b ' puis la 3°
Cells(a, 2).Value = codearticle ' j'inscris la valeur codearticle dans la 1ere cell vide de la colo B
Cells(a + 1, 2).Value = codearticle ' puis dans la 2°
Cells(a + 2, 2).Value = codearticle ' puis la 3°
Cells(a, 3).Value = datedepose ' j'inscris la valeur datedepose dans la 1ere cell vide de la colo B
Cells(a, 4).Value = dateretour ' j'inscris la valeur dateretour dans la 1ere cell vide de la colo B
Cells(a, 4).Select ' je séléctionne la cell A4
nbjours = retour - depose ' je compte le nbre de jours entre datedepose et dateretour
ActiveCell.Offset(0, 1) = depose ' j'inscris la valeur depose dans la colo C (5°) de la meem ligne
For x = 1 To nbjours ' j'inscris les jours les uns à la suite des autres
datesuite = CDate(Cells(a, x + 4).Value) + 1
Cells(a, x + 5).Value = datesuite
Next x
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
Sheets("CODES ARTICLES").Select ' je séléctionne ma feuille ou sont mes code article
Do ' je cherche mon code article
c = c + 1
Loop Until Application.Cells(c, 1) = d
Do ' je cherche la derniere cell de mon code article (horizontalement)
i = i + 1
Loop Until Application.Cells(c, i) = Empty
Range(Application.Cells(c, 2), Application.Cells(c, i)).Select ' je selectionne ma plage de cells de la 2° colo jusqu'à la premiere vide
Selection.Copy ' je copie ma selection
Sheets("SUIVI DES OF").Select ' je selectionne ma feuille de synthèse
Do ' je cherche la ligne créer avec les dates mais par son numero d'OF
e = e + 1
Loop Until Application.Cells(e, 1) = b
Application.Cells(e + 1, 5).Select ' je selectionne la cellule en dessous de la 1ere date
ActiveSheet.Paste ' je colle mon code article
Application.Cells(e + 2, 5).Select ' je selectionne la cellule en dessous de la 1ere copie
ActiveSheet.Paste ' je colle mon code article une 2° fois
Unload Creasupp
End Sub
le If Weekdays je le place dans le code de mise en forme With range ou dans le For Next ?
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
14 oct. 2009 à 10:11
14 oct. 2009 à 10:11
Je viens de tester ton code plusqu'il est plus simple que le mien il m'evite 3 boucle mais il ne marche pas il s'arete à e = .Columns(2).Find(d, .Range("B65536"), xlValues).Row+1 message d'erreur: "variable objet ou variable de bloc with non définie ". . .
pour les weekend formatés j'ai fais ça:
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
If Weekday(vbSunday, vbSaturday) Then
.Interior.ColorIndex = 39
End If
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
ca change le format mais de toutes les dates. . . .
pour les weekend formatés j'ai fais ça:
x = 5
With Range(Cells(a, x), Cells(a, nbjours + x)) ' je formate mes cellules contenant les jours
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 15
If Weekday(vbSunday, vbSaturday) Then
.Interior.ColorIndex = 39
End If
.NumberFormat = "ddd-dd/mm/yy"
.Font.Bold = True
End With
ca change le format mais de toutes les dates. . . .
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
15 oct. 2009 à 07:46
15 oct. 2009 à 07:46
Bon personne n'a de réponse ? ? ? ?
informatifien
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
15 oct. 2009 à 10:45
15 oct. 2009 à 10:45
Mon problème principale est solutionné je post un autre message pour mon autre souci
Merci
Merci