Excel/MACRO copier/coller entre feuilles

Résolu
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

--
MERCI A CCM à déclarer source d'intéret public . .. .. pensez à marquer vos topic résolus quand c'est le cas .. . . .
Configuration: asus P5V800 / P4 2,8 Ghz / 1,5 Go Windows XP FireFox / IE 7

10 réponses

  1. 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
    1. Contributeur
      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
      1. 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
        1. 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
          1. Contributeur
            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
            1. 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
              1. 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
                1. Bon personne n'a de réponse ? ? ? ?
                  0
                  1. Mon problème principale est solutionné je post un autre message pour mon autre souci

                    Merci
                    0