Sub controle()
'
' Cette macro effectue un contrôle des entités et catégories saisies
'
' Dû à une erreur amenée par les liaisons à un document externe, on vient rompre ces liaisons.
If Not IsEmpty(ActiveWorkbook.LinkSources(xlExcelLinks)) Then
For Each X In ActiveWorkbook.LinkSources(xlExcelLinks)
ActiveWorkbook.BreakLink Name:=X, Type:=xlExcelLinks
Next
End If
Sheets("Sheets1").Activate
Columns("E:E").Select
Selection.Replace What:="#N/A", Replacement:="Erreur", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Nettoyage de l'onglet "log_error"
Sheets("log_error").Activate
ActiveSheet.Range("$A$1:$A" & Range("A65536").End(xlUp).Row).Select
Selection.EntireRow.Delete
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "Sheets1"
' On vient ici parcourir les plages de cellule et on vérifie la présence des valeurs dans l'onget de référence pour Sheets1
'Parcours la plage de référence pour la vérification des entités
verif_cell_ent_geo = Sheets("Ref").Range("$A$3:$A$" & Sheets("Ref").Range("A65536").End(xlUp).Row)
' Parcours de la plage saisie par le support
Dim val_cell_ent_geo As Range
For Each val_cell_ent_geo In Sheets("Sheets1").Range("$E$2:$E$" & Sheets("Sheets1").Range("E65536").End(xlUp).Row)
If val_cell_ent_geo.Value <> "" And IsError(Application.VLookup(val_cell_ent_geo.Value, verif_cell_ent_geo, 1, False)) = True Then
' On copie la ligne en défaut dans l'onglet log_error
Sheets("Sheets1").Activate
ActiveSheet.Range("$A" & val_cell_ent_geo.Row & ":$K" & val_cell_ent_geo.Row).Select
Selection.Copy
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Sheets("log_error").Range("A65536").End(xlUp).Row + 1).Select
ActiveSheet.Paste
ActiveSheet.Range("$E" & Sheets("log_error").Range("E65536").End(xlUp).Row).Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
MsgBox "fini !"
End Sub