Enregistrer des données

Bonjour

s'il serait possible de créer bouton d'archiver la feuille RDA dans la feuille ARCHIVE RDA selon les cellules colorés .

je vous remercie.

Bonjour,

Sub Archiver()
    Dim arch(), mc, col, n%, i%, j%, k%, celC As Range
    Set celC = Worksheets("ARCHIVE RDA").Cells(Rows.Count, 1).End(xlUp)(2)
    With ActiveSheet
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
        If n < 8 Then Exit Sub
        mc = Split("K6 P6 Q6 N8 R6"): col = Array(2, 3, 9)
        ReDim arch(n - 8, 7)
        For i = 8 To n
            For j = 0 To 4
                arch(k, j) = .Range(mc(j)).Value2
            Next j
            For j = 0 To 2
                arch(k, j + 5) = .Cells(i, col(j))
            Next j
            k = k + 1
        Next i
        celC.Resize(k, 8).Value = arch
        celC.Worksheet.Activate  'pour voir résultat
        'ci-dessous effacement RDA (à supprimer si on n'efface pas)
        .Range("B8").Resize(k, 8).ClearContents
        For i = 0 To 4
            .Range(mc(i)).MergeArea.ClearContents
        Next i
    End With
End Sub

Cordialement.

salut

je veux ajouter une chose si je clique sur archive la cellule k 6 (feuille RDA) augmente +1.

merci

        'avant effacement
        n= .Range("K6") + 1

        'après effacement
        .Range("K6") = n

Cordialement.

salut

le code devient comme ça?merci

Sub Archiver()

Dim arch(), mc, col, n%, i%, j%, k%, celC As Range

Set celC = Worksheets("ARCHIVE RDA").Cells(Rows.Count, 1).End(xlUp)(2)

With ActiveSheet

n = .Cells(.Rows.Count, 2).End(xlUp).Row

If n < 8 Then Exit Sub

mc = Split("K6 P6 Q6 N8 R6"): col = Array(2, 3, 9)

ReDim arch(n - 8, 7)

For i = 8 To n

For j = 0 To 4

arch(k, j) = .Range(mc(j)).Value2

Next j

For j = 0 To 2

arch(k, j + 5) = .Cells(i, col(j))

Next j

k = k + 1

Next i

celC.Resize(k, 8).Value = arch

celC.Worksheet.Activate 'pour voir résultat

'ci-dessous effacement RDA (à supprimer si on n'efface pas)

'avant effacement

n = .Range("K6") + 1

.Range("B8").Resize(k, 8).ClearContents

For i = 0 To 4

.Range(mc(i)).MergeArea.ClearContents

Next i

'après effacement

.Range("K6") = n

End With

End Sub

C'est ça ! Mais prends l'habitude de mettre le code sous balise Code dans le post, de façon à conserver l'indentation et qu'il soit plus lisible...

Cordialement.

Salut

j'ai envie d'ajouter une chose

la colonne C "FEUILLE ARCHIVE RDA" doit se remplir par la date cellule P6 + NOMBRE DE JOURS CELLULE O34 "FEUILLE RDA "

par exemple

P6:26/06/2017

o34: 5 jours

la colonne C "FEUILLE ARCHIVE RDA= 30/06/2017 (se remplir)

et ainsi les cellules O33 et O34 se supprime avec les autres cellules lorsque je clique sur archiver.

je vous remercie

cordialement

Tu rajoutes :

        mc = Split("K6 P6 Q6 N8 R6 O33 O34")

ça c'est pour l'effacement.

Et pour mettre la valeur, avant la ligne k= k +1 :

            arch(k, 2) = arch(k, 1) + .Range("O34")
            k = k + 1
        Next i

Bonsoir

la colonne C se remplir parfaitement

mais la cellule O33 et O34 se supprime pas je sais pas pour quoi !! merci

Sub Archiver()

Dim arch(), mc, col, n%, i%, j%, k%, celC As Range
Set celC = Worksheets("ARCHIVE RDA").Cells(Rows.Count, 1).End(xlUp)(2)
With ActiveSheet
n = .Cells(.Rows.Count, 2).End(xlUp).Row
If n < 8 Then Exit Sub

mc = Split("K6 P6 Q6 N8 R6 O33 O34"): col = Array(2, 3, 9)

ReDim arch(n - 8, 7)
For i = 8 To n
For j = 0 To 4
arch(k, j) = .Range(mc(j)).Value2
Next j
For j = 0 To 2
arch(k, j + 5) = .Cells(i, col(j))
Next j
arch(k, 2) = arch(k, 1) + .Range("O34")
k = k + 1
Next i
celC.Resize(k, 8).Value = arch
celC.Worksheet.Activate 'pour voir résultat
'ci-dessous effacement RDA (à supprimer si on n'efface pas)
'avant effacement
n = .Range("K6") + 1

.Range("B8").Resize(k, 8).ClearContents
For i = 0 To 4
.Range(mc(i)).MergeArea.ClearContents
Next i
'après effacement
.Range("K6") = n
End With

End Sub

Exact ! Un oubli ici :

        For i = 0 To 6

Remplacer 4 par 6. Désolé !

Salut

merci çà marche bien.

je veux ajouter une chose

si je met 0 dans la cellule O33 (feuille RDA) - la cellule ("colonne A" feuille ARCHIVE RDA ) doit se colorer en rouge.

si je met 1 dans la cellule O33 (feuille RDA) - la cellule ("colonne A" feuille ARCHIVE RDA ) doit se colorer en orange.

si je met 2 dans la cellule O33 (feuille RDA) - la cellule ("colonne A" feuille ARCHIVE RDA ) doit se colorer en jaune.

je vous remercie infiniment.

Il ne faudrait pas prendre l'habitude de rajouter des morceaux en enfilade...

J'apprécie les questions posées globalement en une seule fois, qui fournissent une vue d'ensemble et l'objectif final, dont on peut tenir compte à chaque étape de résolution... beaucoup moins les questions à tiroirs, non annoncées dès le départ, qui obligent à reprendre ce qu'on vient de faire...

De toute façon il y a une petite contradiction dans ta nouvelle demande avec l'étape précédente, qu'il t'appartient de trouver pour définir la bonne solution.

Cordialement.