XL 2016 Décaler groupe cellule (boucle)

Nico_J

XLDnaute Occasionnel
Supporter XLD
Bonjour à tous,

je plante sur un petit bout de code, je cherche à décaler des valeurs de N-1 à N-2 et ainsi de suite,
pour pouvoir y inserrer les nouvelles, j'ai fait ce code si dessous mais non
je joint egalement un apercu pour mieux comprendre

VB:
Sub cloture_TEST()
Dim i As Integer, j As Integer
Dim derlign_ca As Long

For i = 2 To 13
    For j = 2 To 31
        If Sheets("Archive_CA").Cells(i, j) <> "" Then
            Sheets("Archive_CA").Cells(i, j + 1) = Sheets("Archive_CA").Cells(i, j)
            'Sheets("Archive_CA").Cells(i, j) = ""
        End If
    Next
Next
End Sub

Capture.PNG

Merci
 
Solution
re,
juste une chose,
il faut absolument que je soit sur la page en question sinon j'ai l'erreur "la méthode range de l'objet worksheet à échoué"
j'ai donc rajouté "with" "end with" mais sans effet

VB:
Sub cloture_TEST()
Dim i As Integer, j As Integer, Dc As Integer
Set Ws9 = Sheets("CA")
Set Ws10 = Sheets("Archive_CA")

With Ws10
For i = 2 To 13
    For j = 2 To 31
        If Ws10.Cells(i, j) <> "" Then
            Dc = Ws10.Cells(i, Columns.Count).End(xlToLeft).Column
            Ws10.Range(Cells(i, 2), Cells(i, Dc)).Copy Ws10.Cells(i, 3) 'ligne erreur'
            Ws10.Cells(i, 2) = Ws9.Cells(i, 3)
            Exit For
        End If
    Next
Next
End With

For i = 2 To 13
    Ws9.Cells(i, 4) = Ws9.Cells(i, 3): Ws9.Cells(i, 3) = ""...

M12

XLDnaute Accro
Bonjour,
Teste ceci
VB:
Sub cloture_TEST()
Dim i As Integer, j As Integer
Dim Dc%
Dim Ws As Worksheet

Set Ws = Sheets("Archive_CA")
For i = 2 To 13
    For j = 2 To 31
        If Ws.Cells(i, j) <> "" Then
            Dc = Ws.Cells(i, Columns.Count).End(xlToLeft).Column
            Ws.Range(Cells(i, 2), Cells(i, Dc)).Copy Ws.Cells(i, 3)
            Ws.Cells(i, 2) = ""
            Exit For
        End If
    Next
Next
End Sub
 

Nico_J

XLDnaute Occasionnel
Supporter XLD
re,
juste une chose,
il faut absolument que je soit sur la page en question sinon j'ai l'erreur "la méthode range de l'objet worksheet à échoué"
j'ai donc rajouté "with" "end with" mais sans effet

VB:
Sub cloture_TEST()
Dim i As Integer, j As Integer, Dc As Integer
Set Ws9 = Sheets("CA")
Set Ws10 = Sheets("Archive_CA")

With Ws10
For i = 2 To 13
    For j = 2 To 31
        If Ws10.Cells(i, j) <> "" Then
            Dc = Ws10.Cells(i, Columns.Count).End(xlToLeft).Column
            Ws10.Range(Cells(i, 2), Cells(i, Dc)).Copy Ws10.Cells(i, 3) 'ligne erreur'
            Ws10.Cells(i, 2) = Ws9.Cells(i, 3)
            Exit For
        End If
    Next
Next
End With

For i = 2 To 13
    Ws9.Cells(i, 4) = Ws9.Cells(i, 3): Ws9.Cells(i, 3) = ""
    Ws9.Cells(i, 8) = Ws9.Cells(i, 7): Ws9.Cells(i, 7) = ""
Next

Set Ws9 = Nothing
Set Ws10 = Nothing
End Sub
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
286

Statistiques des forums

Discussions
312 194
Messages
2 086 070
Membres
103 110
dernier inscrit
Privé