XL 2019 Copier coller plage variable

duplaly

XLDnaute Occasionnel
Bonjour
Je joins une copie de mon fichier et voici ce que j'essaye de faire.
Je veux archiver les données de la feuille "Rapport" vers la feuille "Archive" tout en inscrivant la date "colonne A" sur chaque ligne jusqu'à la dernière ligne remplie.
À noter que les données dans la feuille "Rapport" sont variables à chaque archivage. J'aimerais que la date soit recopiée en fonction du nombre de lignes remplies.

Chaque archivage doit se coller en dessous de la feuille "Archive".

Merci à l'avance pour votre aide!
 

Pièces jointes

  • Test.xlsx
    16.5 KB · Affichages: 8

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Dans le fichier joint vous trouverez la macro ci-dessous qui fait le job, elle copie les valeurs sans les formats. On peut changer ça mais je crois que c'est mieux ainsi. Je me permets de vous rappeler que pour excel un tableau est définit par un ensemble de cellules contigües et isolées du reste par des colonnes et lignes vides.
Avec excel 2019, il est temps d'utiliser les tableaux structurés.
VB:
Sub ArchiverRapport()
    Dim source As Range
    With ThisWorkbook
        'Définition de la source des données
        With .Sheets("Rapport").Range("A3").CurrentRegion
            ' Tableau de A3 sans ses lignes d'entêtes
            Set source = .Offset(3).Resize(.Rows.Count - 3)
        End With
       
        With .Sheets("Archive").Cells(Rows.Count, 1).End(xlUp)(2)
            'Coller les valeurs en fin de tableau en fonction du nombre de lignes et colonne de la source
            .Resize(source.Rows.Count, source.Columns.Count).Value = source.Value
        End With
    End With
    MsgBox source.Rows.Count & " ligne(s) archivée(s)", vbInformation, "Archivage"
End Sub

cordialement
 

Pièces jointes

  • Archivage.xlsm
    31 KB · Affichages: 4

Jacky67

XLDnaute Barbatruc
Bonjour
Je joins une copie de mon fichier et voici ce que j'essaye de faire.
Je veux archiver les données de la feuille "Rapport" vers la feuille "Archive" tout en inscrivant la date "colonne A" sur chaque ligne jusqu'à la dernière ligne remplie.
À noter que les données dans la feuille "Rapport" sont variables à chaque archivage. J'aimerais que la date soit recopiée en fonction du nombre de lignes remplies.

Chaque archivage doit se coller en dessous de la feuille "Archive".

Merci à l'avance pour votre aide!
Bonsoir à tous
Un exemple en pj avec ce code
VB:
Sub archiver()
    Dim derlg&
    If IsNumeric(Application.Match(Feuil1.[k2], Feuil2.[A:A], 0)) Then MsgBox "Archive déjà existante à cette date.", , "Information": Exit Sub
    derlg = Feuil2.Cells(Feuil2.Rows.Count, "B").End(xlUp).Row + 1
    Feuil1.UsedRange.Offset(3).Resize(Feuil1.UsedRange.Rows.Count - 3).Copy Feuil2.Range("b" & derlg)
    Feuil2.Range("a" & derlg & ":a" & Application.CountA(Feuil2.[b:b]) + 1) = CDate(Feuil1.[k2])
End Sub
 

Pièces jointes

  • Test_Archve.xlsm
    28 KB · Affichages: 2

duplaly

XLDnaute Occasionnel
Hello
Bonsoir à tous
Un exemple en pj avec ce code
VB:
Sub archiver()
    Dim derlg&
    If IsNumeric(Application.Match(Feuil1.[k2], Feuil2.[A:A], 0)) Then MsgBox "Archive déjà existante à cette date.", , "Information": Exit Sub
    derlg = Feuil2.Cells(Feuil2.Rows.Count, "B").End(xlUp).Row + 1
    Feuil1.UsedRange.Offset(3).Resize(Feuil1.UsedRange.Rows.Count - 3).Copy Feuil2.Range("b" & derlg)
    Feuil2.Range("a" & derlg & ":a" & Application.CountA(Feuil2.[b:b]) + 1) = CDate(Feuil1.[k2])
End Sub
Jacky
Je ne suis pas loin de la solution avec ton code.
Possible de coller juste valeur. Présentement, le code copie tout et ce n'est pas bon pour moi.

Merci
 

Jacky67

XLDnaute Barbatruc
Hello

Jacky
Je ne suis pas loin de la solution avec ton code.
Possible de coller juste valeur. Présentement, le code copie tout et ce n'est pas bon pour moi.

Merci
Re..
Ben.. il n'y a pas de formules......
Néanmoins, ceci
VB:
Sub archiver()
    Dim derlg&
    If IsNumeric(Application.Match(Feuil1.[k2], Feuil2.[A:A], 0)) Then MsgBox "Archive déjà existante à cette date.", , "Information": Exit Sub
    derlg = Feuil2.Cells(Feuil2.Rows.Count, "B").End(xlUp).Row + 1
    Feuil1.UsedRange.Offset(3).Resize(Feuil1.UsedRange.Rows.Count - 3).Copy
    Feuil2.Range("b" & derlg).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Feuil2.Range("a" & derlg & ":a" & Application.CountA(Feuil2.[b:b]) + 1) = CDate(Feuil1.[k2])
    Application.CutCopyMode = False
End Sub
Et ajout de :
**Application.CutCopyMode = False
 

Pièces jointes

  • Test_ArchveV2.xlsm
    28.3 KB · Affichages: 7
Dernière édition:

duplaly

XLDnaute Occasionnel
Merci beau
Re..
Ben.. il n'y a pas de formules......
Néanmoins, ceci
VB:
Sub archiver()
    Dim derlg&
    If IsNumeric(Application.Match(Feuil1.[k2], Feuil2.[A:A], 0)) Then MsgBox "Archive déjà existante à cette date.", , "Information": Exit Sub
    derlg = Feuil2.Cells(Feuil2.Rows.Count, "B").End(xlUp).Row + 1
    Feuil1.UsedRange.Offset(3).Resize(Feuil1.UsedRange.Rows.Count - 3).Copy
    Feuil2.Range("b" & derlg).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Feuil2.Range("a" & derlg & ":a" & Application.CountA(Feuil2.[b:b]) + 1) = CDate(Feuil1.[k2])
    Application.CutCopyMode = False
End Sub
Et ajout de :
**Application.CutCopyMode = False
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,
Bel avancement pour moi. il faut juste traiter la date.

Voici :
VB:
Sub ArchiverRapport()
    Dim source As Range
    With ThisWorkbook
        'Définition de la source des données
        With .Sheets("Rapport").Range("A3").CurrentRegion
            ' Tableau de A3 sans ses lignes d'entêtes
            Set source = .Offset(3).Resize(.Rows.Count - 3)
        End With

        With .Sheets("Archive").Cells(Rows.Count, 1).End(xlUp)(2)
           .Offset(, 1).Resize(source.Rows.Count, source.Columns.Count + 1).Value = source.Value
           .Resize(source.Rows.Count, 1).Value = Date
        End With
    End With
    MsgBox source.Rows.Count & " ligne(s) archivée(s)", vbInformation, "Archivage"
End Sub

Allez voir ma réponse sur l'autre fil :
 
Dernière édition:

Discussions similaires

Réponses
56
Affichages
907
Réponses
24
Affichages
1 K

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088