Discussion :

[Mad02]

Bonjour,

Dans mon classeur Excel il y a un onglet "BDD" ainsi qu'un onglet "CA12A"
Dans mon onglet BDD j'ai en colonne J différent type de TVA dont CA12A
J'ai exécuter un code VBA qui me permet de recopier automatiquement les toutes les lignes des colonnes de B à I de la BDD qui comporte CA12A vers l'onglet CA12A et ceux même lors que je rajoute une nouvelle ligne dans la BDD qui comporte se critère.

Mon problème étant que : dans mon onglet CA12 en colonne J, K, L, ... ce sont des informations que je rentre manuellement sans qu'elles soit dans ma BDD;
Par exemple en colonne J, ce sera la date de mon premier acompte, en colonne K des commentaires ...
Sauf que quand je rajoute une ligne dans ma BDD, que j'exécute la macro pour que la ligne soit également insérer dans mon onglet CA12A, ca ne me décale pas les infos rentrer manuellement.
Il faudrait que ma ligne s'insère sur la totalité.
C'est à dire que si je rentre un nouveau client dans ma BDD en ligne 10, il faut que dans mon onglet CA12A, la ligne 10 soit insérer entièrement et que mes donnée se trouvant dans mes colonnes J,K,L se décale aussi vers le bas.

J'ai essayer d'être le plus clair possible
Je vous joint un fichier qui ressemblerait a celui sur lequel je travail.

Suivi Dossier test.xlsm

Ci-dessous le Code utilisé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub CopierNouvellesLignesAvecMiseEnForme()
    Dim wsBDD As Worksheet
    Dim wsCA12A As Worksheet
    Dim lastRowBDD As Long
    Dim lastRowCA12A As Long[ATTACH]657044[/ATTACH][ATTACH]657044[/ATTACH]
    Dim i As Long
    Dim copiedRows As Object
    Dim newRow As Range
 
    Set copiedRows = CreateObject("Scripting.Dictionary")
 
    ' Définir les feuilles de travail
    Set wsBDD = ThisWorkbook.Sheets("BDD")
    Set wsCA12A = ThisWorkbook.Sheets("CA12A")
 
    ' Trouver la dernière ligne de données dans chaque feuille
    lastRowBDD = wsBDD.Cells(wsBDD.Rows.Count, 1).End(xlUp).Row
    lastRowCA12A = wsCA12A.Cells(wsCA12A.Rows.Count, 1).End(xlUp).Row
 
    ' Filter les données pour ne travailler qu'avec les nouvelles lignes dans BDD
    With wsBDD
        .AutoFilterMode = False ' Supprimer les filtres existants
        .Range("A9:J" & lastRowBDD).AutoFilter Field:=10, Criteria1:="CA12A"
 
        For i = 9 To lastRowBDD
            If Not .Cells(i, 10).EntireRow.Hidden Then ' Vérifier si la ligne n'est pas masquée
                Dim key As String
                key = ""
                For Each cell In .Range("B" & i & ":I" & i)
 
                key = key & cell.Text
                Next cell
 
 
                If Not copiedRows.Exists(key) Then ' Vérifier si la ligne n'a pas été déjà copiée
                    If i > lastRowCA12A Then ' Vérifier si c'est une nouvelle ligne
 
                        ' Copier les données dans CA12A avec la mise en forme
                       .Range("B" & i & ":I" & i).Copy
 
                        wsCA12A.Cells(lastRowCA12A + 8, 2).PasteSpecial Paste:=xlPasteAll
 
                        .Range("O" & i & ":R" & i).Copy
                        wsCA12A.Cells(lastRowCA12A + 8, 10).PasteSpecial Paste:=xlPasteAll
 
 
                        Application.CutCopyMode = False ' Effacer le Presse-papiers
                        copiedRows.Add key, "Copied" ' Ajouter la ligne à la liste des lignes copiées
                        lastRowCA12A = lastRowCA12A + 1 ' Mettre à jour la dernière ligne dans CA12A
                    End If
                End If
            End If
        Next i
    End With
 
    ' Supprimer le filtre une fois le traitement terminé
    wsBDD.AutoFilterMode = False
End SubDE

[Nain porte koi]

Hello,

ajoutez

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

                        wsCA12A.Rows(lastRowCA12A + 8).Insert Shift:=xlDown

ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
                    If i > lastRowCA12A Then ' Vérifier si c'est une nouvelle ligne
 
                        wsCA12A.Rows(lastRowCA12A + 8).Insert Shift:=xlDown
 
                        ' Copier les données dans CA12A avec la mise en forme
                       .Range("B" & i & ":I" & i).Copy

[Mad02]

Bonjour Nain porte koi,

Merci pour votre proposition, mais elle ne fonctionne pas.
En effet elle me recopie une nouvelle fois toutes mes lignes à la suite des lignes déjà copié

Je vous remet le fichier en pièce jointe
Suivi Dossier test.xlsm

Je vous remercie.

Mad'

[Nain porte koi]

Re,

désolé, mais c'est votre macro, l'instruction que je vous ai donné ne fais qu'ajouter une ligne avant la copie. Vous devriez revoir votre code en incluant cette insertion.