Copier une ligne dans un autre classeur si totalement rempli

Bonjour à tous, j'ai besoin de vous pour optimiser un code vba. Je n'y arrive pas seul ;/

J'ai déjà fait appel, ici même pour ce genre de problème.

J'aimerai optimiser voir simplifier son utilisation.

Le sujet en question était ici :

https://forum.excel-pratique.com/excel/copier-les-valeurs-d-un-tableau-deja-existant-avec-condition-t100207.html

J'ai besoin de copier une ligne (tableau1) dans un autre classeur (tableau2), à partir du moment où toutes les colonnes ont été renseigné (de B à K).

Les deux tableaux sont exactement les mêmes.

Cela sert à archiver les lignes Complètes, donc il faut que j'ajoute à ça le fait d'effacer la ligne qui a été copier du tableau 1 ou alors de faire un couper à la place de copier...

Mes conditions serait donc :

(Pour qu'il s'agit bien d'une ligne complète) Si une cellule de la colonne K = non vide; alors copier cette ligne sur le classeur 2.

A la suite des autres ...

Si quelqu'un peux m'aider à comprendre comment faire. Merci d'avance.

Bonjour,

Est-ce-que les choses ont évolué ... depuis la macro de copie sans doublons ...

Sub CopieDonnéesJour2()
' Copie des Données du Fichier Jour au Fichier Récap 'SANS' les Doublons '''''''''''''''''''''''''''''''''''''''''''''''
' Déclaration des quatre variables
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim der1 As Long
Dim der2 As Long
Dim c As Range
Dim res As Variant

' Stopper rafraichissement de l'écran
  Application.ScreenUpdating = False
' Définir le fichier 1 - Jour
  Set wkb1 = ActiveWorkbook
' Définir la dernière ligne du fichier 1 -Jour
  der1 = ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
' Si la dernière ligne = 2 sortir de la macro
  If der1 = 2 Then Exit Sub
' Ouvrir le fichier Récap siuté dans le même sous-répertoire que le fichier Jour
  Workbooks.Open Filename:=wkb1.Path & "\PF RECAP.xlsm"
'Définir le fichier 2 - Récap
  Set wkb2 = ActiveWorkbook
' Activer le fichier 2
  wkb1.Activate
' Faire les copies des données
   For Each c In wkb1.Sheets(1).Range("C3:C" & der1)
       res = Application.Match(c, wkb2.Sheets(1).Range("C3:C500"), 0)
       If IsError(res) Then
       'Définir la dernière ligne du fichier 2 - Récap
       der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
           ' Copie record
          wkb2.Sheets(1).Range("B" & der2 & ":H" & der2).Value = wkb1.Sheets(1).Range("B" & c.Row & ":H" & c.Row).Value
       End If
    Next c
 ' Activer le fichier 2
  wkb2.Activate
' Sauver et Fermer le fichier 2
  wkb2.Close savechanges:=True
' Ré-Autoriser le rafraichissement de l'écran
 Application.ScreenUpdating = True
End Sub

Bonjour, oui nous nous sommes rendu compte, après quelques semaines d'utilisation de ce qu'il fallait pour l'optimiser ...

L'idéale serai que la copie se fasse, seulement sur les lignes où la colonne K est renseigné.

Comme ça, chaque ligne "terminé" ira s'archiver sur le deuxième classeur.

Re,

Dans ton premier message tu dis

J'ai besoin de copier une ligne dans un autre classeur à partir du moment où toutes les colonnes ont été renseignées (de B à K).

Dans ton second message tu dis

L'idéal serait que la copie se fasse, seulement sur les lignes où la colonne K est renseignée

Peux-tu confirmer quelle est la bonne version ...

Oui, j'ai éditer avant ton message.

C'est bien la condition "colonne K" renseigné.

JdViRuS a écrit :

Oui ...

C'est bien la condition "colonne K" renseigné.

Re,

Merci pour cette clarification ... indispensable ...

Il suffit donc de rajouterou modifier un test .... ce que je vais te préparer ...

Accessoirement, la première version allait de la Colonne B à la Colonne H .... donc tu as bien rajouté trois Colonnes ... pour aller jusqu'à la Colonne K ...

Sub CopieDonnéesJour3()
' Copie des Données du Fichier Jour au Fichier Récap 'SANS' les Doublons '''''''''''''''''''''''''''''''''''''''''''''''
' UNIQUEMENT si la Colonne K est renseignée ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Déclaration des quatre variables
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim der1 As Long
Dim der2 As Long
Dim c As Range
Dim res As Variant

' Stopper rafraichissement de l'écran
  Application.ScreenUpdating = False
' Définir le fichier 1 - Jour
  Set wkb1 = ActiveWorkbook
' Définir la dernière ligne du fichier 1 -Jour
  der1 = ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
' Si la dernière ligne = 2 sortir de la macro
  If der1 = 2 Then Exit Sub
' Ouvrir le fichier Récap siuté dans le même sous-répertoire que le fichier Jour
  Workbooks.Open Filename:=wkb1.Path & "\PF RECAP.xlsm"
'Définir le fichier 2 - Récap
  Set wkb2 = ActiveWorkbook
' Activer le fichier 2
  wkb1.Activate
' Faire les copies des données
   For Each c In wkb1.Sheets(1).Range("K3:K" & der1)
       If c <> "" Then
          res = Application.Match(c, wkb2.Sheets(1).Range("K3:K500"), 0)
          If IsError(res) Then
          'Définir la dernière ligne du fichier 2 - Récap
          der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
              ' Copie record
             wkb2.Sheets(1).Range("B" & der2 & ":K" & der2).Value = wkb1.Sheets(1).Range("B" & c.Row & ":K" & c.Row).Value
          End If
        End If
    Next c
 ' Activer le fichier 2
  wkb2.Activate
' Sauver et Fermer le fichier 2
  wkb2.Close savechanges:=True
' Ré-Autoriser le rafraichissement de l'écran
 Application.ScreenUpdating = True
End Sub

En espèrant que cela t'aide

Oui, mais j'ai en fait deux cas à faire. Mais ne t'en fait pas pour ça, je l'adapterai.

Tu peux à la limite te servir des fichier exemple du premier sujet et j'adapterai en fonction.

Merci !

Re,

Je viens d'éditer le message précédent pour y inclure ta macro modifiée ...

Ton code fonctionne. Peut on couper à la place de copier ? Ou effacer la ligne qui a été copier ?

JdViRuS a écrit :

Ton code fonctionne. Peut on couper à la place de copier ? Ou effacer la ligne qui a été copier ?

Re,

Voici donc ta macro modifiée .... re-modifiée .. version 4 ...

Sub CopieDonnéesJour4()
' Copie des Données du Fichier Jour au Fichier Récap 'SANS' les Doublons '''''''''''''''''''''''''''''''''''''''''''''''
' UNIQUEMENT si la Colonne K est renseignée ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ET supprime totalement la ligne sur laquelle la Colonne K est renseignée '''''''''''''''''''''''''''''''''''''''''''''
' Déclaration des quatre variables
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim der1 As Long
Dim der2 As Long
Dim c As Range
Dim res As Variant

' Stopper rafraichissement de l'écran
  Application.ScreenUpdating = False
' Définir le fichier 1 - Jour
  Set wkb1 = ActiveWorkbook
' Définir la dernière ligne du fichier 1 -Jour
  der1 = ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
' Si la dernière ligne = 2 sortir de la macro
  If der1 = 2 Then Exit Sub
' Ouvrir le fichier Récap siuté dans le même sous-répertoire que le fichier Jour
  Workbooks.Open Filename:=wkb1.Path & "\PF RECAP.xlsm"
'Définir le fichier 2 - Récap
  Set wkb2 = ActiveWorkbook
' Activer le fichier 2
  wkb1.Activate
' Faire les copies des données
   For Each c In wkb1.Sheets(1).Range("K3:K" & der1)
       If c <> "" Then
          res = Application.Match(c, wkb2.Sheets(1).Range("K3:K500"), 0)
          If IsError(res) Then
          'Définir la dernière ligne du fichier 2 - Récap
          der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
              ' Copie record
             wkb2.Sheets(1).Range("B" & der2 & ":K" & der2).Value = wkb1.Sheets(1).Range("B" & c.Row & ":K" & c.Row).Value
             '  Supprime la Ligne
             wkb1.Sheets(1).Rows(c.Row & ":" & c.Row).Delete Shift:=xlUp
          End If
        End If
    Next c
 ' Activer le fichier 2
  wkb2.Activate
' Sauver et Fermer le fichier 2
  wkb2.Close savechanges:=True
' Ré-Autoriser le rafraichissement de l'écran
 Application.ScreenUpdating = True
End Sub

Merci , j'essai de comprendre pourquoi ça ne fonctionne pas pour toutes les lignes mais je ne trouve pas ce qui cloche.

Certaine lignes sont bien copiées et effacées mais pas toutes. Et même si elles sont bien renseigné et numéro unique en colonne B.

J'ai trouvé où ça ne fonctionne pas !

C'est lorsqu'une date est identique en colonne B, il ne copie pas.

JdViRuS a écrit :

J'ai trouvé où ça ne fonctionne pas !

C'est lorsqu'une date est identique en colonne B, il ne copie pas.

Re,

Il me semble que ton souhait initial était d'éviter les doublons ...

Oui, mais il me semblai que c'était la colonne C et pas B.

Car la colonne B c'est une date, et je peux en avoir plusieurs à la même date.

Je peux changer "B" en "C" simplement ?

Il me semblai que la condition de doublon étais faite seulement dans la colonne C.

Si je change le "B" en "G", ça fonctionne mais ça n'efface pas systématiquement les lignes.

Tu peux me dire ce que je doit changer pour que la condition se fasse uniquement via la colonne G ?

La colonne G sera toujours unique, car la colonne B est une date et il peux y avoir plusieurs à la même date, et la colonne C est un numéro a 5 chiffre mais ça peut aussi arriver q'un jour j' en ai deux du même numéro.

der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1

der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "G").End(xlUp).Row + 1

Avec mes essais je remarque qu'il y a aussi une condition de doublon avec la date en K

Re,

Tu auras certainement remarquè, pour que tu gagnes en autonomie ... que je t'ai ajouté des commentaires qui apparaissent, dans la macro, ... en vert ...

Cela te permet de modifier les colonnes à ta guise, de faire des tests et d'adapter la macro à tous tes fichiers ...

Oui mais tu pourrai remarqué que tu a commenté mais rien n'indique la condition des doublons !

Je remarque avec mes essais que les doublons visiblement sont évité en colonne B et H. Mais je voulais simplement en être certain.

Re,

JdViRuS a écrit :

Oui mais tu pourrais remarquer que tu as commenté mais rien n'indique la condition des doublons !

Tu as totalement raison ... !!!

Désolé pour cet oubli ...

If IsError(res) Then

est l'instruction qui teste si la ligne n'est pas déjà présente ...

La vérification est faite à ligne précédente ... dans ta colonne K ...

Ok, merci !

Donc il n'y a qu'une seule condition de vérification de doublon ? En K ?

C'est important de savoir cela ...

De rien ...

Si tu trouves d'autres instructions que tu ne comprends pas ...

Il ne faut pas hésiter à demander ...

Merci, je progresse .. Doucement mais je progresse

James007 a écrit :

De rien ...

Si tu trouves d'autres instructions que tu ne comprends pas ...

Il ne faut pa hésiter à demander ...

Si je change :

  If c <> "" Then
          res = Application.Match(c, wkb2.Sheets(1).Range("k3:k500"), 0)
          If IsError(res) Then

En :

 If c <> "" Then
          res = Application.Match(c, wkb2.Sheets(1).Range("h3:h500"), 0)
          If IsError(res) Then

Je ne devrai pas avoir de doublon ?!

Alors que j'ai l'impression qu'il n'y a plus de vérification de cette condition...

Ai-je louper quelque chose ?