Simplification du code

[teecaf]

Bonjour,

Je voudrais savoir si c'est possible de simplifier ce code. Il fonctionne parfaitement mais je dois relancer la boucle sur 20 autres séries de ligne et ça fera environ près de 500 lignes de code. La prochaine série sera copiée en O1, ensuite en AC1 ...

En gros on vérifie si la cellule A10 est vide. SI c'est le cas on sélectionne la plage A11:K200 et on le colle en A1. Si A10 n'est pas vide on vérifie si A9 est vide et si c'est le cas on sélectionne la plage A10:K200 et on le colle en A1. Ainsi de suite jusqu'à vérifier le contenu de A1.

Merci pour votre aide.

Teecaf

    Sub Macr1()
    Dim Ligne As Long
    Dim I As Long
    Sheets("Ja").Select
                  
    If Range("A10").Value = "" Then
    Range("A11:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A9").Value = "" Then
    Range("A10:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A8").Value = "" Then
    Range("A9:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A7").Value = "" Then
    Range("A8:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A6").Value = "" Then
    Range("A7:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A5").Value = "" Then
    Range("A6:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A4").Value = "" Then
    Range("A5:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A3").Value = "" Then
    Range("A4:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A2").Value = "" Then
    Range("A3:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    If Range("A1").Value = "" Then
    Range("A2:K200").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
     
End Sub

 

[Efgé]

Re : Simplification du code

Bonjour teecaf
Je ne vois pas vraiment l'interet, mais comme ça, il y a moins de ligne....🙄
Pour la suite, un petit fichier exemple avec le pourquoi du comment, serait bien utile.

Sub Test()
Dim I As Long
Sheets("Ja").Select
For I = 10 To 1 Step -1
    If Range("A" & I).Value = "" Then
        Range("A" & I + 1 & ":K200").Copy
        Range("A1").PasteSpecial Paste:=xlPasteValues
    End If
Next I
End Sub

Cordialement

EDIT Salut Papou-net 🙂, bien d'accord 😉

 

[Papou-net]

Re : Simplification du code

Bonjour teecaf,

Je ne sais pas si ça répond à ta demande, mais tu peux essayer avec une boucle :

Sub Macr1()
    Dim Ligne As Long
    Dim I As Long
    Sheets("Ja").Select
    For Ligne = 10 To 1 Step -1
      If Range("A" & Ligne) = "" Then
        Range("A" & Ligne + 1).Copy
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
        Exit Sub
      End If
    Next
End Sub

Reste à adapter la boucle pour balayer les colonnes, mais là un fichier support serait souhaitable.

Cordialement.

Oups, collision : salut Efgé.

 

[teecaf]

Re : Simplification du code

Merci Efgé et Papou-net pour votre réactivité.

Vos formules fonctionnent parfaitement et me voila allégé d'une centaines de lignes de codes.

Cordialement