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.
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.
Code:
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
Dernière édition: