Tronquer "ActiveSheet.UsedRange"

[Magic_Doctor]

Bonsoir,

Dans ma feuille je nomme "Zone1" toute la plage de cellules où il y a quelque chose (tableau, cellule isolée contenant une valeur...).
Si je modifie le contenu de la feuille en augmentant, par exemple, la taille d'un tableau, je voudrais automatiquement, au moyen d'une macro, redéfinir la plage qui correspond à "Zone1".
Dans un premier temps j'efface le nom "Zone1".
Ensuite je redéfinis l'aire de "Zone1" et renomme cette plage "Zone1". Pour ce faire j'utilise "ActiveSheet.UsedRange".
Le problème est que l'aire correspondante déborde de l'aire que je veux assigner à "Zone1".

Un grand merci pour m'aider à y remédier.

 

[job75]

Re : Tronquer "ActiveSheet.UsedRange"

Bonsoir Magic Doctor,

Essaie ceci :

Sub MiseAJour1()
Dim cel As Range, plage As Range
For Each cel In ActiveSheet.UsedRange
  If Not IsEmpty(cel) Or _
      cel.Borders(xlEdgeLeft).LineStyle = 1 And _
      cel.Borders(xlEdgeTop).LineStyle = 1 And _
      cel.Borders(xlEdgeBottom).LineStyle = 1 And _
      cel.Borders(xlEdgeRight).LineStyle = 1 Then
    Set plage = Range(cel, IIf(plage Is Nothing, cel, plage))
  End If
Next
On Error Resume Next
ThisWorkbook.Names("Zone1").Delete
plage.Name = "Zone1"
End Sub

A+

 

[Compte Supprimé 979]

Re : Tronquer "ActiveSheet.UsedRange"

Bonsoir

Peut-être comme ça

Set plage = Range("B3:" & Cells.SpecialCells(xlCellTypeLastCell).Offset(-1, -3).Address)

A+

 

[job75]

Re : Tronquer "ActiveSheet.UsedRange"

Bonjour Doctor, bonjour Bruno 🙂

Bruno, il faut repérer B3... Et la dernière ligne peut ne pas contenir de bordures...

Si l'on veut repérer n'importe quel style de bordures, tester avc xlNone :

Sub MiseAJour()
Dim cel As Range, plage As Range
For Each cel In ActiveSheet.UsedRange
  If Not IsEmpty(cel) Or _
      cel.Borders(xlEdgeLeft).LineStyle <> xlNone And _
      cel.Borders(xlEdgeTop).LineStyle <> xlNone And _
      cel.Borders(xlEdgeBottom).LineStyle <> xlNone And _
      cel.Borders(xlEdgeRight).LineStyle <> xlNone Then
    Set plage = Range(cel, IIf(plage Is Nothing, cel, plage))
  End If
Next
On Error Resume Next
ThisWorkbook.Names("Zone1").Delete
plage.Name = "Zone1"
MsgBox [Zone1].Address 'pour tester
End Sub

Voir fichier.

A+

 

[job75]

Re : Tronquer "ActiveSheet.UsedRange"

Re,

Et s'il n'y a pas de bordures intérieures, on peut repérer la 1ère et la dernière cellule de chaque tableau :

Sub MiseAJour()
Dim cel As Range, plage As Range
For Each cel In ActiveSheet.UsedRange
  If Not IsEmpty(cel) Or _
      cel.Borders(xlEdgeLeft).LineStyle <> xlNone And _
      cel.Borders(xlEdgeTop).LineStyle <> xlNone Or _
      cel.Borders(xlEdgeBottom).LineStyle <> xlNone And _
      cel.Borders(xlEdgeRight).LineStyle <> xlNone Then
    Set plage = Range(cel, IIf(plage Is Nothing, cel, plage))
  End If
Next
On Error Resume Next
ThisWorkbook.Names("Zone1").Delete
plage.Name = "Zone1"
MsgBox [Zone1].Address 'pour tester
End Sub

Fichier (2).

A+

 

[Magic_Doctor]

Re : Tronquer "ActiveSheet.UsedRange"

Bonjour job75, BrunoM45,

Merci pour vos réponses.
J'avais bidouillé un truc qui commençait à marcher.
C'est job qui obtient le meilleur résultat.

Encore merci et bonne journée à tous.

En pièce jointe les 3 solutions.