Ajouter une suppression dans ma macro sur des cellule

Question

Voila mon sujet, j'aimerait ajouter une suppression qui me supprime les cellules ("B7:C7") après que ("B7:G7") ont été copiées, voici la macro, Sub Macro3() Dim tablo, tabloR(), j&, k& ActiveSheet.Unprotect tablo = Range("B7:G7") k = 0 For j = 1 To UBound(tablo, 2) If tablo(1, j) &lt;&gt; "" Then ReDim Preserve tabloR(1, k + 1) tabloR(0, k) = tablo(1, j) k = k + 1 Else MsgBox "la cellule " & Cells(7, j + 1).Address & " est vide." & Chr(13) & "On ne copie donc rien.", 16 Selection.ClearContents Exit Sub End If Next j Range("B6").Resize(1, UBound(tabloR, 2)) = tabloR ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFiltering:=True End Sub...

gmb · Accepted Answer

Alors voilà :

Option Explicit

Sub Macro3()
    Dim tablo, tabloR(), j&, k&
    ActiveSheet.Unprotect
    tablo = Range("B7:G7")
    k = 0
    For j = 1 To UBound(tablo, 2)
        If tablo(1, j) <> "" Then
            ReDim Preserve tabloR(1, k + 1)
            tabloR(0, k) = tablo(1, j)
            k = k + 1
        Else
            MsgBox "la cellule " & Cells(7, j + 1).Address & " est vide." & Chr(13) & "On ne copie donc rien.", 16
            Selection.ClearContents
            Exit Sub
        End If
    Next j
    Range("B6").Resize(1, UBound(tabloR, 2)) = tabloR
    Range("B7.G7").ClearContents
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
    End Sub

Bye !

gmb · Answer

Encore faudrait-il préciser s'il s'agit : de décaler vers la gauche de décaler vers le haut de supprimer toute la ligne de supprimer les 2 colonnes A moins qu'il ne s'agisse que d'effacer B7:C7 ? Bye ...