Copier des données d'un classeur à un autre

Bonjour Mimi, bonjour le forum,

Je commence a travailler sur ton fichier mais plusieurs choses me gênent.

• Coment va-t-on envoyer les données ?

- un bouton car si on le fait en automatique, a quel moment doit-on déclencher l'envoi ?
- quand une ligne est remplie (avec les cellules fusionnées bonjour) ?
- quand la date est changée ?
- quand le numéro de lot est changé ?

• les cellules fusionnées ennemies du VBA
• Peut-on envisagé le tableau de l'onglet visco6 sans cellules fusiuonnées ?
• pourquoi deux colonnes dans le tableau de l'onglet visco6 ?

Serait-il possible d'avoir les donnés présentées comme cela :
https://www.cjoint.com/?ECbo2KjnI5G

Bonsoir Mimi, bonsoir le forum,

• Dans quel onglet (nom ou position) sont éditées les données source et dans quel onglet (nom ou position) doivent-elles être copiées ?
• Quel est le chemin d'accès du fichier Source ? Du fichier Destination (Bureau ok, mais selon la version de Windows, le chemin d'accès au bureau est différent) ?
• Quelle version d'Excel utilises-tu ?

Attendant tes réponses...

Bonsoir ThauThem, bonsoir le forum

-J'utilise Excel 2013
-les chemins d'accès au fichier sont:
pour le dossier Source "C:\Users\amir_2\Desktop\checklist.xlsm"
pour le dossier Destinataire "C:\Users\amir_2\Desktop\archive.xlsm"
-l'onglet ou sont éditées les données source sont sur la feuille 'visco6" et sur les cellules de A15 à O30 et elles doivent être enregistrer dans le classeur "archive" feuille "archive 2015".

Merci d'avance

j'ai oublier, l'enregistrement dois se faire sur les cellules D10, D11, D12 ect... bien évidement, si une des cellules est renseigné l'enregistrer à la suite pour éviter d'écraser les ancienne données.

Merci

Re,

Voici les 2 dossiers, j'aimerai aussi savoir si c'est possible de renseigner 2 autres cellules "date " et "numéro de lot" dans le classeur "Archive"
Merci d'avance pour tout

checklist...........https://www.cjoint.com/?ECbbOiaN0xH
Archive.............. https://www.cjoint.com/?ECbbMZa5RUy

Bonsoir Mimi, bonsoir le forum,

J'ai modifié la présentation des données (suppression des cellules fusionnées) et ajouté un bouton Envoi. Au clic sur ce bouton les données sont envoyées dans le classeur archive puis sont effacées du classeur checklist. À adapter...
LE code du bouton :

Private Sub CommandButton1_Click() 'bouton Envoi
ActiveCell.Select 'enlève le focus au bouton
Module1.Macro1 'lance la procédure [Marco1] du module [Module1]
ThisWorkbook.Sheets("lot").Range("C5:C6").ClearContents 'efface date et numéro de lot
ThisWorkbook.Sheets("Visco6").Range("A2:A17").ClearContents 'efface la liste de non conformité
End Sub

Le code de la macro :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS1 As Worksheet 'déclare la variable OS1 (Onglet Source 1)
Dim OS2 As Worksheet 'déclare la variable OS2 (Onglet Source 2)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Byte 'déclare la variable I (Incrément)

Set CS = ThisWorkbook 'définit le classeur source CS
CH = ThisWorkbook.Path & "\" 'définit le chemin d'accès CH
Set OS1 = CS.Sheets("lot") 'définit l'onglet OS1
Set OS2 = CS.Sheets("visco6") 'définit l'onglet OS2
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("archive.xlsm") 'définit le classeur destination CD (génère une erreur si ce classeur est fermé)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err = 0 'annule l'erreur
    Application.Workbooks.Open (CH & "archive.xlsm") 'ouvre le classeur destination "archive.xlsm"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("archive 2015") 'définit l'onglet destination OD
'boucle dur tous les cellules éditées (en partant de la seconde) de la colonne 1 (=A) de l'onglet OS2
For I = 2 To OS2.Cells(Application.Rows.Count, 1).End(xlUp).Row
    Set DEST = OD.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    DEST.Value = OS1.Range("C6").Value 'récupère la date
    DEST.Offset(0, 1).Value = OS2.Cells(I, 1).Value 'récupère le type de nom conformité
    DEST.Offset(0, 2).Value = OS1.Range("C5").Value 'récupère le numéro de lot
Next I 'prochaine ligne de la boucle
'tu peux éventuellement fermer le classeur destination avec : CD.Close SaveChanges:=True
End Sub

Les fichiers :
https://www.cjoint.com/?ECbrpWP6rI9

À plus,
ThauTheme

Bonsoir thauthem, bonsoir le forum,

Désolé pour cette réponse tardif, je rentre d'une belle journée au ski:)

je vais commencer par répondre à tes questions:

Comment va-t-on envoyer les données ?
j'ai pensé à mettre une condition "si cellule non vide" envoyé, mais un bouton me va très bien aussi

- quand une ligne est remplie (avec les cellules fusionnées bonjour) ?
Ok pour désactiver la fusion des cellules

- quand la date est changée ? la date on l'oublie j'ai une autre idée je m'en occupe. j'ai une macro date que je mettrai dans le classeur archive

- quand le numéro de lot est changé ? le numéro de lot est saisie en début et ne se change jamais

pourquoi deux colonnes dans le tableau de l'onglet visco6 ?
car ma feuille d'origine est chargé donc en manque de place:)

Re,

je viens d'essayer les codes:

les problèmes;

1- les non-conformité sont bien copier dans le classeur archive, mais écrase les anciens au bout de la deuxième ligne............

2-les non-conformité renseigner dans le classeur "checklist ne doivent pas s'effacer..................

3- A partir du deuxième non-conformité le numéro de lot n'ai plus renseigner...............

Merci pour le temps que vous sacrifier pour moi....
Merci d'avance

Re,

je viens de supprimer 2 ligne sur la macro, et cela fonctionne, sauf qu'a chaque fois que je fais envoyé, il me réécrit tous sur le classeur Archive, faut-il un bouton par cellule?

macro supprimé:
ThisWorkbook.Sheets("lot").Range("C5:C6").ClearContents 'efface date et numéro de lot
ThisWorkbook.Sheets("Visco6").Range("A2:A17").ClearContents 'efface la liste de non conformité

merci

Re,

Voici un vrai dossier sur lequel je travail, les cellules à renseigner sont en jaune,

https://www.cjoint.com/?ECbw7wdAfKr

je m'explique, l'opérateur note sur une des cellules en jaune sa non-conformité, puis j'aimerai que cette non conformité soit enregistrer dans le classeur "archive" sans écraser les anciennes.

je ne voudrai pas que la macro m'envoi à chaque fois la totalité des non conformité. je veux la faire par cellules

Ne faut-il pas un bouton par cellule pour l'envoie ?
Ou supprimé le bouton et mettre une condition "exemple après la saisie de la cellule, ou si cellules contient "x"?

Vous en pensez quoi?

A savoir le classeur "Archive" et souvent utiliser par d'autre service, c'est pour cela que je veux que la macro écrit sur une cellule vide, mais à la suite

si je ne suis pas claire dite le moi, car c'est pas facile a tout bien expliquer:(

Merci encore

Bonjour Mimi, bonjour le forum,

En pièce jointe une nouvelle version. Plus besoin de bouton (d'ailleurs j'ai supprimé les deux premières lignes de ton fichier), la macro réagit au changement (édition/modification/effacement) des cellules en jaune.
Comme tu ne m'as pas répondu au sujet de la fusion des cellules, j'ai aussi modifié la présentation dans l'onglet LOT.

Attention ! Si tu copies/Colles le code dans ton fichier il faudra adapter les plages et adresses écrites en dur...

Le code (dans le composant Feuil1(VISCO 6)) :

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onlget
Dim PL As Range 'déclare la variable PL (PLage)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS1 As Worksheet 'déclare la variable OS1 (Onglet Source 1)
Dim OS2 As Worksheet 'déclare la variable OS2 (Onglet Source 2)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Byte 'déclare la variable I (Incrément)

'target désigne la cellule qui subit un changement (édition/modification/effacement)
If Target.Value = "" Then Exit Sub 'si la cellule est efffacée, sort de la procédure
If Target.Cells.Count > 1 Then Exit Sub 'si plusieurs cellules sélectionnées, sort de la procédure
Set CS = ThisWorkbook 'définit le classeur source CS
CH = ThisWorkbook.Path & "\" 'définit le chemin d'accès CH
Set OS1 = CS.Sheets("LOT") 'définit l'onglet OS1
Set OS2 = CS.Sheets("VISCO 6") 'définit l'onglet OS2
'définit la plage PL
Set PL = Application.Union(OS2.Range("A53:A58"), OS2.Range("I53:I58"), OS2.Range("A110:A115"), OS2.Range("I110:I115")) 'à adapter si tu rajoutes des cellules jaunes
'si le changement a lieu ailleurs qu'en PL, sort de la procédure (limite l'action de la macro à la plage PL uniquement)
If Application.Intersect(Target, PL) Is Nothing Then Exit Sub
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("archive.xlsm") 'définit le classeur destination CD (génère une erreur si ce classeur est fermé)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err = 0 'annule l'erreur
    Application.Workbooks.Open (CH & "archive.xlsm") 'ouvre le classeur destination "archive.xlsm"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("archive 2015") 'définit l'onglet destination OD
Set DEST = OD.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
If OS1.Range("C7") = "" Or OS1.Range("C11") = "" Then 'condition : si le numéro de lot et/ou la date ne sont pas renseignés
    OS1.Activate 'active l'onglet OS1 (="LOT")
    OS1.Range("C7").Select 'sélectionne la cellue C7
    MsgBox "Vous devez renseigner le numéro de lot et la date !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
DEST.Value = OS1.Range("C11").Value 'récupère la date
DEST.Offset(0, 1).Value = Target.Value 'récupère le type de nom conformité
DEST.Offset(0, 2).Value = OS1.Range("C7").Value 'récupère le numéro de lot
'tu peux éventuellement fermer le classeur destination avec : CD.Close SaveChanges:=True
End Sub

Le fichier :
https://www.cjoint.com/?ECclBPxmB1n

Bonjour ThauThem, Bonjour le Forum

Bravo, un excellent travail, c'est vraiment ce que je chercher.
je vais copier / coller le code et l'adapter en fonction.
je vous tiens au courant.

Mille merci et encore BRAVO!!!!!!!!!!!!!!!!!!!!!!!!!!

Re,

J'ai déjà un code avec Private Sub Worksheet_Change(ByVal Target As Range)

Dois-je le mettre a l'intérieur de ce code ?
ou le mettre après ce code End sub???

Bonjour Mimi, bonjour le forum,

Malheureusement il te faut l'intégrer à ce code ! Cela risque d'être délicat... Mais il me faut ce code pour voir comment on pourrait bidouiller les deux...

Bonjour ThauThem, bonjour le forum

Voici le fichier avec mon code

https://www.cjoint.com/?ECcoVfygdG9

merci:)

Bonjour Mimi, bonjour le forum,

J'ai intégré le code j'espère que ça ne va pas planter :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS1 As Worksheet 'déclare la variable OS1 (Onglet Source 1)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Byte 'déclare la variable I (Incrément)

'target désigne la cellule qui subit un changement (édition/modification/effacement)
Set CS = ThisWorkbook 'définit le classeur source CS
CH = ThisWorkbook.Path & "\" 'définit le chemin d'accès CH
Set OS1 = CS.Sheets("LOT") 'définit l'onglet OS1
'définit la plage PL
Set PL = Application.Union(Range("A53:A58"), Range("I53:I58"), Range("A110:A115"), Range("I110:I115")) 'à adapter si tu rajoutes des cellules jaunes
'si le changement a lieu ailleurs qu'en PL, sort de la procédure (limite l'action de la macro à la plage PL uniquement)
If Not Application.Intersect(Target, PL) Is Nothing Then
    If Target.Value = "" Then Exit Sub 'si la cellule est efffacée, sort de la procédure
    If Target.Cells.Count > 1 Then Exit Sub 'si plusieurs cellules sélectionnées, sort de la procédure
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set CD = Workbooks("archive.xlsm") 'définit le classeur destination CD (génère une erreur si ce classeur est fermé)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err = 0 'annule l'erreur
        Application.Workbooks.Open (CH & "archive.xlsm") 'ouvre le classeur destination "archive.xlsm"
        Set CD = ActiveWorkbook 'définit le classeur destination CD
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    Set OD = CD.Sheets("archive 2015") 'définit l'onglet destination OD
    Set DEST = OD.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    If OS1.Range("C7") = "" Or OS1.Range("C11") = "" Then 'condition : si le numéro de lot et/ou la date ne sont pas renseignés
        OS1.Activate 'active l'onglet OS1 (="LOT")
        OS1.Range("C7").Select 'sélectionne la cellue C7
        MsgBox "Vous devez renseigner le numéro de lot et la date !" 'message
        Exit Sub 'sort de la procédure
    End If 'fin de la condition
    DEST.Value = OS1.Range("C11").Value 'récupère la date
    DEST.Offset(0, 1).Value = Target.Value 'récupère le type de nom conformité
    DEST.Offset(0, 2).Value = OS1.Range("C7").Value 'récupère le numéro de lot
'tu peux éventuellement fermer le classeur destination avec : CD.Close SaveChanges:=True
End If

'ecriture automatique date
On Error Resume Next
If Not Intersect(Target, [I19:O19,I76:O76,I133:O133,I190:O190,I247:O247]) Is Nothing Then ' cellule de saisie
    Target(2, 1) = Now  'le premier chiffre c'est le numero de ligne et le  deuxieme c'est la colone
End If
'bloquer cellules apres saisie
If Not Intersect(Target, Range("A19:O50,A52:O107,A109:O164,A166:O221,A223:O278,A280:O288")) Is Nothing Then
    Target.Locked = True
'code signature electronique...................................................
ElseIf Not Application.Intersect(Target, Range("I51:O51,I108:O108,I165:O165,I222:O222,I279:O279")) Is Nothing Then
    If Target = Empty Then
        'efface commentaire
        Target.ClearComments
    Else
    'recherche si Initiales existe
    With Worksheets("paramètre")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        Set Col_A = .Range("A41:A" & derlig)
        If Application.CountIf(Col_A, Target) <> 1 Then
            MsgBox "N'existe pas!!!!!!"
            Exit Sub
        Else
            lig = 1
            lig = .Columns(1).Find(Target, .Cells(lig, 1), , xlWhole).Row
            TPass = .Range("C" & lig)
            'appel UF Mot de passe
            UF_PassWord.Lbl_Operateur = .Range("B" & lig)
            Operateur = .Range("B" & lig)
        End If
    End With
    UF_PassWord.Show
    If TPass = -1 Then
    Else
        Application.EnableEvents = False
        Application.Undo
    End If
End If
Target.Locked = True 'bloquer cellule signature electronique
' fin code signature electronique..............................................
End If
Application.EnableEvents = True
End Sub

Tu devras regarder la concordance dans ton code avec les plage et adresses en dur (par exemple : I165:O165 ou I222:O222 ou I279:O279 qui n'existe plus et les autres à vérifier)...

Bonjour ThauThem, bonjour le forum

1000 MERCI
cela fonctionne à merveille!!!!!!!!!!!!!!!!!!

je voudrais juste faire 2 réglages,
Je souhaiterai supprimé la date, car j'ai une autre idée que je mettrai en place sur le classeur "archive"

-Dois-je supprimé ce code?
DEST.Value = OS1.Range("C11").Value 'récupère la date

Ensuite je voudrai supprimé la condition si le numéro de lot et/ou la date ne sont pas renseignés, car j'ai ce code dans une autre feuille

-Dois-je supprimer ce code?

If OS1.Range("C7") = "" Or OS1.Range("C11") = "" Then 'condition : si le numéro de lot et/ou la date ne sont pas renseignés
OS1.Activate 'active l'onglet OS1 (="LOT")
OS1.Range("C7").Select 'sélectionne la cellue C7
MsgBox "Vous devez renseigner le numéro de lot et la date !" 'message

y-a t-il autre chose à supprimé ou à corrigé?

Merci pour tout

Bonjour Mimi, bonjour le forum,

C'est ça avec juste le End If à la fin ! Tu as tout compris...

Bonjour ThauThem, bonjour le forum

le Exit sub aussi ?

If OS1.Range("C7") = "" Or OS1.Range("C11") = "" Then 'condition : si le numéro de lot et/ou la date ne sont pas renseignés
OS1.Activate 'active l'onglet OS1 (="LOT")
OS1.Range("C7").Select 'sélectionne la cellue C7
MsgBox "Vous devez renseigner le numéro de lot et la date !" 'message
Exit Sub 'sort de la procédure
End If 'fin de la condition

Bonsoir Mimi, bonsoir le forum,

Oui aussi...