Enregistrer les données

Salut tout le monde

je veux créer bouton pour sauvegarder les données du tableau de la feuille 1 dans la feuille 2. avec msg box "c bon données enregistré

je vous remercie

cordialement

salut

a ce moment je n'ai reçu aucune réponse .merci

mes salutations

SALUT CHERS AMIS

je cherche a enregistrer le tableau de la feuille 01 dans la base de donne (archive) de la feuille 02.

voir fichier ci-joint tout est explique ( emplacement . les cellule enregistre..) selon les couleurs.

thank you so much

mes salutations

bonjour,

une solution possible, à tester

Sub aargh()
    Set ws = Sheets("sheet1")
    dl = ws.Range("B8").End(xlDown).Row
    With Sheets("sheet2")
        k = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 8 To dl
            k = k + 1
            .Cells(k, 1) = ws.Range("K6")
            .Cells(k, 2) = ws.Range("P6")
            .Cells(k, 3) = ws.Range("N8")
            .Cells(k, 4) = ws.Range("R6")
            .Cells(k, 5) = ws.Range("B" & i)
            .Cells(k, 6) = ws.Range("C" & i)
            .Cells(k, 7) = ws.Range("I" & i)
            .Cells(k, 8) = ws.Range("A39")
        Next i
    End With
End Sub

SALUT

IL NE FONCTIONNE PAS.MERCI

Bonjour,

Sub aargh()
    Set ws = Sheets("sheet1")
    With Sheets("sheet2")
        k = .Cells(Rows.Count, 1).End(xlUp).Row
        i = 8
        While ws.Cells(i, "B") <> ""
            k = k + 1
            .Cells(k, 1) = ws.Range("K6")
            .Cells(k, 2) = ws.Range("P6")
            .Cells(k, 3) = ws.Range("N8")
            .Cells(k, 4) = ws.Range("R6")
            .Cells(k, 5) = ws.Range("B" & i)
            .Cells(k, 6) = ws.Range("C" & i)
            .Cells(k, 7) = ws.Range("I" & i)
            .Cells(k, 8) = ws.Range("A39")
        i = i + 1
        Wend
    End With
End Sub
 

SALUT

c'est parfait

je veux ajouter une chose

si le numéro de la requête (CELLULE K6) est archiver dejas

il m'affiche une message box que la requête a dejas saisis.pour éviter de saisir la requête en deux fois.

je vous remercie

re-bonjour

Sub aargh()
    Set ws = Sheets("sheet1")
    With Sheets("sheet2")
        k = .Cells(Rows.Count, 1).End(xlUp).Row
        i = 8
        Set re = .Columns(1).Find(ws.Range("K6"), lookat:=xlWhole)
        If re Is Nothing Then
            While ws.Cells(i, "B") <> ""
                k = k + 1
                .Cells(k, 1) = ws.Range("K6")
                .Cells(k, 2) = ws.Range("P6")
                .Cells(k, 3) = ws.Range("N8")
                .Cells(k, 4) = ws.Range("R6")
                .Cells(k, 5) = ws.Range("B" & i)
                .Cells(k, 6) = ws.Range("C" & i)
                .Cells(k, 7) = ws.Range("I" & i)
                .Cells(k, 8) = ws.Range("A39")
                i = i + 1
            Wend
            MsgBox ws.Range("K6") & " archivé"
        Else
            MsgBox ws.Range("K6") & " déjà archivé"
        End If
    End With
End Sub

Bonsoir

impeccable .merci bcp

si c'est possible d'ajouter un bouton supprimer les cellule qu'on archive cellule colorées + cellule O32 (feuille1).

et lorsque je clique sur supprimer le numéro de la requête cellule k6 augment+1

thank you

mes salutations

re-bonjour,

Sub supprimer()
    With Sheets("sheet1")
        For Each r In Split("P6:Q6,B8:I24,N8,A39:Q39,O32:Q33", ",")
            .Range(r).ClearContents
        Next
        .Range("K6") = .Range("k6") + 1
    End With
End Sub

Bonsoir

parfait

je chercher à ajouter un calendrier dans la cellule P6.svp

merci à toi

cordialement

Salut

je veux ajouter quelque chose tel que ce code au bouton d'archive parce que lorsque j'archive le fichier il doit s'archive sans les boutons.

merci

Set wkbSource = ThisWorkbook

'wkbSource.SaveCopyAs PathA & FileName1 & "_" & FileName2 & ".xlsm" ', FileFormatvalue = 52

'ActiveWorkbook.Close savechanges:=False

Application.DisplayAlerts = False

wkbSource.Worksheets(1).Copy

ActiveSheet.Shapes.Range(Array("Button 1")).Delete

ActiveSheet.Shapes.Range(Array("Button 2")).Delete

ActiveSheet.Shapes.Range(Array("Button 3")).Delete

ActiveWorkbook.SaveAs PathA & FileName1 & "_" & FileName2 & ".xlsx", xlOpenXMLWorkbook, CreateBackup:=False

ActiveWorkbook.Close savechanges:=False

End Sub