Ajouter ne pas copier les lignes vide à ma Macro

Bonjour à tous vu que je suis nouveau je ne connait pas bien excel-pratique,

Pourriez-vous m'aider à modifier ma macro pour que les cellules ("B7:G7") lors se quelles sont vide ne me recopie rien en B6

Sub Macro3()

ActiveSheet.Unprotect

Range("B7:G7").Select

Selection.Copy

Range("B6").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("B7:C7").Select

Application.CutCopyMode = False

Selection.ClearContents

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowFiltering:=True

End Sub

Bonjour et bienvenue sur le forum

Essaie ce code :

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
        End If
    Next j
    Range("B6").Resize(1, UBound(tabloR, 2)) = tabloR
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
 End Sub

Bye !

Merci pour ton aide gmb mais au lieus de ne pas copier les cellules vides sa me recopie des valeur d'autre cellule.

Alors, joins ton fichier avec un exemple de ce que tu veux obtenir...

Bye !

gmb a écrit :

Bonjour et bienvenue sur le forum

Essaie ce code :

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
        End If
    Next j
    Range("B6").Resize(1, UBound(tabloR, 2)) = tabloR
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
 End Sub

Bye !

DSl j'ai du male m'expliquer, en fait lors se que ("B7:G7") ont des valeur vide sa ne recopie aucune valeur en B6

Alors, essaie ça :

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
            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

Bye !

gmb a écrit :

Alors, joins ton fichier avec un exemple de ce que tu veux obtenir...

Bye !

gmb a écrit :

Alors, essaie ça :

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
            Exit Sub
        End If
    Next j

Merci sa marche nickel 2 autres service peut on ajouter dans ta macro que les cellules b7 et c7 se supprime après le collage, et si il, y a une façon pour incorporer ma macro a plusieurs boutons tout en se modifiant pour chaque ligne ou je doit le faire manuellement
    Range("B6").Resize(1, UBound(tabloR, 2)) = tabloR
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
 End Sub

Bye !

Merci sa marche nickel 2 autres service peut on ajouter dans ta macro que les cellules b7 et c7 se supprime après le collage, et si il, y a une façon pour incorporer ma macro a plusieurs boutons tout en se modifiant pour chaque ligne ou je doit le faire manuellement.