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 |
Partager