Microsoft 365 Copie de données d'une feuille vers une autre et retour à la ligne

[Pat13127]

Bonjour la communauté !
Je recherche une moyen de copier des données d'une feuille vers une autre.

J'ai une première feuille nommée POINT_CA et je souhaite recopier des données vers la Feuille SYNTHESE_CA

Voilà mon code de départ :

Sub Copie_CA()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
Dim LI As Long 'déclare la variable LI (LIgne)
Dim TB(1 To 16) As Variant 'déclare la variable TB (TaBleau)
Set OS = Worksheets("POINT_CA") 'définit l'onglet source OS
Set OC = Worksheets("SYNTHESE_CA") 'définit l'onglet cible OC
LI = OC.Range("A" & Rows.Count).End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne A de l'onglet cible OC
TB(1) = OS.Range("D6").Value 'définit TB(1)
TB(2) = OS.Range("A16").Value 'définit TB(2)
TB(3) = OS.Range("B16").Value 'définit TB(3)
TB(4) = OS.Range("C16").Value 'définit TB(4)
TB(5) = OS.Range("D16").Value 'définit TB(5)
TB(6) = OS.Range("E16").Value 'définit TB(6)
TB(7) = OS.Range("F16").Value 'définit TB(7)
TB(8) = OS.Range("G16").Value 'définit TB(8)

OC.Cells(LI, "A").Resize(1, 8) = TB 'renvoie le tableau TB dans la cellule redimensionnée ligne LI colonne A
MsgBox "LE CONTENU A ETE SAUVEGARDE !"

End Sub

Cela me copie bien les données de A16 à G16 ( D6 est la date ).

Je n'arrive pas à aller à la ligne pour recopier en dessous de cela pour copier :
A17,B17,C17,D17,E17,F17 et G17

....et ainsi de suite jusqu'à A21:G21

Tout marche bien , mais en définitive je n'arrive pas à "aller à la ligne" entre chaque série de données...
J'aurais aimé joindre mon fichier mais il contient trop de données que j'aurais à masquer.
Merci pour toute votre aide !
;-)

 

[chagatte]

Bonjour,

Essaye simplement en faisant une boucle sur tes lignes puis en réinitialisant le variant TB à chaque boucle.

Sub Copie_CA()

    Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
    Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
    Dim LI As Long 'déclare la variable LI (LIgne)
    Dim TB(1 To 16) As Variant 'déclare la variable TB (TaBleau)
    Set OS = Worksheets("POINT_CA") 'définit l'onglet source OS
    Set OC = Worksheets("SYNTHESE_CA") 'définit l'onglet cible OC
    
    For i = 16 To 21
    
        LI = OC.Range("A" & Rows.Count).End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne A de l'onglet cible OC
        TB(1) = OS.Range("D6").Value 'définit TB(1)
        TB(2) = OS.Range("A" & i).Value 'définit TB(2)
        TB(3) = OS.Range("B" & i).Value 'définit TB(3)
        TB(4) = OS.Range("C" & i).Value 'définit TB(4)
        TB(5) = OS.Range("D" & i).Value 'définit TB(5)
        TB(6) = OS.Range("E" & i).Value 'définit TB(6)
        TB(7) = OS.Range("F" & i).Value 'définit TB(7)
        TB(8) = OS.Range("G" & i).Value 'définit TB(8)
        
        OC.Cells(LI, "A").Resize(1, 8) = TB 'renvoie le tableau TB dans la cellule redimensionnée ligne LI colonne A
        Erase TB
        
    Next i
    
    MsgBox "LE CONTENU A ETE SAUVEGARDE !"

End Sub

 

[Pat13127]

Bonjour Chagatte et merci pour ta réponse.
Je vais essayer ta proposition et ne manquerai pas de te donner mon retour ! Merci encore !!!

 

[Pat13127]

Je viens de tester et UN ENORME MERCI !!!!!!
Parfaitement ce dont j'avais besoin !!!!

 

[Pat13127]

Je viens de tester et UN ENORME MERCI !!!!!!
Parfaitement ce dont j'avais besoin !!!!

Bonjour à tous !
Je fais remonter mon sujet, car pour être tout à fait parfaite ma formule pourrait-elle conserver la mise en forme conditionnelle des cellules d'origine ? N'utilisant pas la fonction Paste:=xlPasteValues, je ne sais pas comment m'y prendre.... Merci encore par avance,
;-)

 

[chagatte]

Dans ce cas-là utilise plutôt un copier / coller sans passer par une variable tableau, comme ceci. Attention ce code copie le format + bordures + valeurs.

Sub Copie_CA()

    Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
    Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
    Dim LI As Long 'déclare la variable LI (LIgne)

    Set OS = Worksheets("POINT_CA") 'définit l'onglet source OS
    Set OC = Worksheets("SYNTHESE_CA") 'définit l'onglet cible OC
    

        LI = OC.Range("A" & Rows.Count).End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne A de l'onglet cible OC
        OC.Range("A" & LI & ":" & "A" & LI + 5).Value = OS.Range("D6").Value
        OC.Range("B" & LI & ":" & "H" & LI + 5).Value = OS.Range("A16:G21").Value
        OS.Range("A16:G21").Copy
        OC.Range("B" & LI & ":" & "H" & LI + 5).PasteSpecial Paste:=xlPasteFormats
        OS.Range("D6").Copy
        OC.Range("A" & LI & ":" & "A" & LI + 5).PasteSpecial Paste:=xlPasteFormats
    
    MsgBox "LE CONTENU A ETE SAUVEGARDE !"

End Sub

 

[Pat13127]

Merci !!!!
Vraiment au top, cela correspond complètement à mon besoin.
Mille merci à tous !