XL 2010 Copier selon conditions sur autre classeur dans l'ordre

[jdjlecto]

Bonjour, je pêche sur un sujet depuis un moment alors je viens voir ici si un connaisseur pourra me sortir de là ^^.
Voilà mon problème;
J'ai un tableau avec 10 en-tête de B à J.
Sur ce tableau j'ajoute des données au fur et à mesure (donc tous les champs ne sont pas entré forcément en une seule fois).
J'ai besoin qu'à chaque fois que j'entre une donnée, qu'une copie se fasse automatiquement , dans un autre tableau qui n'est pas exactement le même et au fur et à mesure (par un bouton ou de manière automatique).
Mais surtout qu'il n'y est pas de doublon dans le tableau qui reçoi la copie, et que les info s'accumule de ligne en ligne sans en écraser et sans faire d'espace.
Quelqu'un pense avoir une solution ?
Je débute en VBA, j'en apprend chaque jour mais là j'ai vraiment besoin.

J'ai été aider pour avoir de quoi copier, et sans doublon mais ça ne fonctionne que si tous les champs on été rempli.

Option Explicit

Sub Cp2()
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim der1 As Long
Dim der2 As Long
Dim c As Range
Dim res As Variant

  Application.ScreenUpdating = False
  Set wkb1 = ActiveWorkbook
  der1 = ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
  If der1 = 2 Then Exit Sub
  Workbooks.Open Filename:=wkb1.Path & "\fichier1.xlsm"
  Set wkb2 = ActiveWorkbook
  wkb1.Activate
   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
 
       der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
          wkb2.Sheets(1).Range("B" & der2 & ":I" & der2).Value = wkb1.Sheets(1).Range("B" & c.Row & ":I" & c.Row).Value
       End If
    Next c
  wkb2.Activate
  wkb2.Close savechanges:=True
Application.ScreenUpdating = True
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

@jdjlecto
Je t'avouerais que j'ai un peu lâché l'affaire 😉
Ça serait chouette que d'autres pensent à passer dans ton fil pour te filer à coup de main 😉

 

[jdjlecto]

Ce n'est pas grave j'ai réussi à me débrouiller. 😉

 

[Staple1600]

Bonsoir le fil, le forum

@jdjlecto

Ce n'est pas grave j'ai réussi à me débrouiller. 😉

Dans ce cas, pour rester dans l'esprit du partage de connaissances de ce forum, peut-être pourrais-tu poster le code VBA de ta macro finalisée, non?
Cela pourrait peut-être servir ultérieurement à d'autres membres du forum 😉

 

[jdjlecto]

Oui, je me suis fait aider sur un autre forum, puis j'ai adapter en rapport à ma situation.

Sub CopieDonnéesJour3()
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim der1 As Long
Dim der2 As Long
Dim c As Range
Dim res As Variant
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
der1 = ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
If der1 = 2 Then Exit Sub
Workbooks.Open Filename:=wkb1.Path & "\PF RECAP.xlsm"
Set wkb2 = ActiveWorkbook
  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
         der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
             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
wkb2.Activate
wkb2.Close savechanges:=True
Application.ScreenUpdating = True
End Sub