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 |
