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
Et Re bonjour,
me revoilà avec la suite de mon code, maintenant que mes dates s’affichent toutes seules grâce à Bidouilleu_R (MERCI), je souhaite maintenant que ma macro recherche un code dans une liste se trouvant dans une autre feuille, ce code étant taper dans une box de mon userform, je veux ensuite copier la ligne correspondante au code puis la coller dans la première feuille là ou mes dates s’affichent (en dessous et en double si possible), j’ai mis des commentaires pour rendre mon code plus clair en espérant que cela suffise. . .
Le code marche jusqu'à la ligne : Worksheets("CODES ARTICLES").Row.Copy
Message d’erreur : propriété ou methode non gérée par cet objet
Voici le 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, 2) = d


Worksheets("CODES ARTICLES").Row.Copy ‘ je copy la ligne sur la quel ma boucle s’arête
Worksheets("SUIVI DES OF").Select ‘ 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 = 1
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 colle la ligne à partir de la colonne E une ligne en dessous de là ou s’est arrêtée la boucle
Exit Sub

Unload Creasupp
End Sub



Voilà si quelqu’un a une petite idée ce serait cool

Merci d’avance


A voir également:

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
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 . . .
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
13 oct. 2009 à 18:17
Bonjour au lieu de:
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
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
13 oct. 2009 à 18:24
ci joint tite démo sur la partie étudiée
https://www.cjoint.com/?knsxx78i1L
0
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
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
0

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
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
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
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
0
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
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 ?
0
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
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. . . .
0
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
Bon personne n'a de réponse ? ? ? ?
0
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
Mon problème principale est solutionné je post un autre message pour mon autre souci

Merci
0