Si cellule non vide décalage d'une partie de la ligne

Bonjour à tous,

J'ai un document à mettre en forme et j'ai une macro le faisant bien. J'ai un léger soucis sur quelques lignes cependant, le document étant une extraction d'un autre logiciel, les utilisateurs ont une zone de texte libre ce qui donne lieu à des décalages sur une partie de certaines lignes une fois en format Excel.

L'objectif est donc de parcourir la colonne "Memo" à la recherche d'une cellule non vide, et s'il y en a une, décaler la ligne sur laquelle elle est à gauche de 1 colonne.

Je vous joins mon code avec un fichier exemple (en rouge la cellule qui devrait être vide et en jaune les cellules à décaler de 1 vers la gauche) en espérant que quelqu'un saura m'aiguiller.

Sub Rectif_LayoutWIP()

 Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft

    Rows("1:10").Select
    Selection.Delete Shift:=xlUp

     Range("A1").Select
    ActiveCell.FormulaR1C1 = "Mat type"

'Tri pour suppression

    Cells.Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A2:F6500")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    If Not IsEmpty(Range("C2:C1500")) Then Range("D2:F1500").Offset(0, -1)

End Sub

Bonjour Kala, bonjour le forum,

Ton code modifié avec une boucle à la fin :

Sub Rectif_LayoutWIP()
Dim DL As Integer
Dim I As Integer

Application.ScreenUpdating = False
Columns("A:A").Delete Shift:=xlToLeft
Rows("1:10").Delete Shift:=xlUp
Range("A1").Value = "Mat type"
'Tri pour suppression
Cells.Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range( _
"A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A2:F6500")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
DL = Cells(Application.Rows.Count, 1).End(xlUp).Row
For I = 2 To DL
    If Cells(I, 3).Value <> "" Then Cells(I, 3).Delete xlShiftToLeft
Next I
Application.ScreenUpdating = True
End Sub

Il faut toujours éviter le Select inutiles qui ne font que ralentir l'exécution du code !...

Bonjour ThauThème,

Merci infiniment pour ton aide rapide, ça marche parfaitement.

Par contre je ne comprends pas pourquoi mon "If Not IsEmpty"ne fonctionnait pas... Dans tous les cas merci encore

Re,

La fonction IsEmpty ne s'applique pas a un objet Range (cellule ou plage ), elle permet de vérifier si une variable a été initialisé ou pas, par exemple .

De plus pour vérifier si une plage est vide il faut soit une boucle sur chaque cellule de la plage ou un code qui compte les cellules non vides du style :

 Dim CV As Integer
 CV = Application.WorksheetFunction.CountA(Range("C2:C1500"))

Pour finir, le décalage ne devait se faire que si il existait une cellule non vide mais pas toute la plage D2:F1500.

Ton code ne pouvait donc pas fonctionner...

Re,

Merci pour tes explications !

A plus

Edit : Sur un autre document la colonne peut présenter du texte et je souhaite donc appliquer le décalage seulement s'il y a un nombre dans la colonne.. J'ai tenté ça en vain et je ne trouve pas comment traduire..

DL = Cells(Application.Rows.Count, 1).End(xlUp).Row
For U = 2 To DL
    If Cells(U, 47).IsNumeric Then Cells(U, 47).Insert Shift:=xlShiftToRight
Next U

Par avance merci.