Microsoft 365 Première cellule vide ou égal zéros dans une plage définie

juju91 · 22 Novembre 2025

Re bonjour,

Encore un problème que je vous soumets
J'ai ''créé'' le petit code ci-dessous qui permet que copier la cellule active et celle adjacente dans la première cellule vide d'une autre colonne.

J'ai plusieurs problème..
Je souhaiterais coller (la valeur) des deux cellules dans la première cellule qui et vide OU la première cellule qui est égal à zéro.
et si possible avoir un message qui s'affiche si toutes les cellules de la plage définie sont déjà remplies ( hors vide ou résultat formule égal à zéro)

Private Sub COPIE_BAR_Click()
Application.ScreenUpdating = False
Cells(ActiveCell.Row, "B").Select
ActiveCell.Offset(, 0).Resize(, 2).Copy
Cells(ActiveCell.Row, "j").Select
Range("J74:J18").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
End Sub

je joins u fichier pour que ma demande soit plus simple à comprendre.....

Cdt

fanch55 · 24 Novembre 2025

fanch55 à dit:
Me.Shapes(Btn_Name).TopLeftCell.Resize(, 2).Copy

Le code fourni copie la cellule se trouvant sous le bouton "Copie_Bar"avec la cellule adjacente à droite de celle-ci .

juju91 à dit:
il y a juste un petit problème, désolé.
Les cellules copiées sont celles au dessus de la cellule active.
J'aurais souhaité que ce soit la cellule active et adjacente a droite qui soient copiés.

Vous voulez dire que lorsque vous cliquez sur le bouton "COPIE_BAR",
vous voulez copier la cellule de la colonne B sur la même ligne que la sélection , cette dernière pouvant être n'importe où ?
Dans ce cas là, à quoi vous servent tous les autres activex de la colonne B ?, le bouton aurait plus sa place à coté de l'activex "Image124"

Voici le code permettant de...

sousou · 22 Novembre 2025

Bonjour.
pas tout compris!
peut-tu préciser en donnant un exemple du résultat à obtenir
je click (ici) je copie tels cellules à cet emplacement.
c'est quoi la plage définit?
quid des ligne masquée?

fanch55 · 22 Novembre 2025

Bonjour, pareil que @sousou
Le code ne colle pas à ce que tu décris, tu veux copier où ?
je présume qu'en fait Range("J74:J18").Select serait plutôt Range("J74:J78").Select ?
Associer autant d'activex ne va pas forcément t'aider

gbinforme · 22 Novembre 2025

Bonjour à tous
Avec ce que j'ai compris ce code devrait fonctionner :

VB:

Private Sub COPIE_BAR_Click()
Dim cel As Range
    Cells(ActiveCell.Row, "B").Resize(1, 2).Copy
    For Each cel In Range("J74:J78")
        If IsEmpty(cel) Or cel.Value = 0 Then
            cel.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Exit For
        End If
    Next cel
End Sub

fanch55 · 22 Novembre 2025

gbinforme à dit:

Bonjour à tous
Avec ce que j'ai compris ce code devrait fonctionner :

VB:

Private Sub COPIE_BAR_Click()
Dim cel As Range
    Cells(ActiveCell.Row, "B").Resize(1, 2).Copy
    For Each cel In Range("J74:J78")
        If IsEmpty(cel) Or cel.Value = 0 Then
            cel.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next cel
End Sub

Salut @gbinforme,
attention: Cells(ActiveCell.Row, "B") ne présume pas que ce soit la cellule associée à l'activex ...

fanch55 · 22 Novembre 2025

Ci-dessous un code qui devrait répondre à votre demande si je l'ai bien interprétée :

VB:

Option Explicit

Private Sub COPIE_BAR_Click()
    Copy_Zone "Copie_Bar", [J74:J78]
End Sub

Private Sub CommandButton2_Click()
    Copy_Zone "CommandButton2", [J74:J78]
End Sub

Private Sub CommandButton3_Click()
    Copy_Zone "CommandButton3", [J74:J78]
End Sub

Sub Copy_Zone(Btn_Name As String, Zone As Range)
    Dim Target As Range
    Me.Shapes(Btn_Name).TopLeftCell.Resize(, 2).Copy
    
    Set Target = Zone.Find("", Zone.Cells(Zone.Rows.Count), LookIn:=xlValues, searchdirection:=xlNext)
    If Target Is Nothing Then Set Target = Zone.Find(0, Zone.Cells(Zone.Rows.Count), LookIn:=xlValues, searchdirection:=xlNext)
    If Not Target Is Nothing Then
        Target.Resize(, 2).PasteSpecial Paste:=xlPasteValues
    Else
        MsgBox "Pas de celulles disponibles dans la zone " & Zone.Address, vbCritical
    End If

End Sub

Attention, il n'évite pas les doublons

gbinforme · 22 Novembre 2025

fanch55 à dit:
Salut @gbinforme,
attention: Cells(ActiveCell.Row, "B") ne présume pas que ce soit la cellule associée à l'activex ...

re
c'est bien celle qui est active que l'on copie comme dans la demande indépendamment du bouton.

fanch55 · 22 Novembre 2025

gbinforme à dit:
re
c'est bien celle qui est active que l'on copie comme dans la demande indépendamment du bouton.

Que ce soit n'importe quelle cellule sélectionnée n'a pas de sens ,
mais c'est effectivement la demande initiale ....

fanch55 · 22 Novembre 2025

Une solution sans passer par des activex :

VB:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next: [zoneCopy].Delete: On Error GoTo 0
    
    Select Case True
    Case Target.Count > 1
    Case Target = ""
    Case Target.Column = Columns("B").Column
        With Me.Shapes.AddShape(msoShapeRightArrow, Target.Left + 5, Target.Top, 20, Target.Height)
            .Name = "zoneCopy"
            .OLEFormat.Object.Interior.Color = RGB(255, 255, 204)
            .OnAction = Me.CodeName & ".Copy_Zone"
        End With
    End Select
End Sub

Public Sub Copy_Zone()
    Dim Target As Range, Source As Range, Zone As Range
    Dim StartCell As Range, EndCell As Range
    
' Pour déterminer la plage d'application ( Zone ),
' on se base sur les bordures de séparation des lignes
' la ligne de début a la bordure supérieure <> Pointillé (xlHairline)
' la ligne de fin a la bordure inférieure <> Pointillé (xlHairline)

    Set StartCell = Me.Shapes(Application.Caller).TopLeftCell
    Do While (StartCell.Borders(xlEdgeTop).Weight = xlHairline)
        Set StartCell = StartCell.Offset(-1)
    Loop
    
    Set EndCell = Me.Shapes(Application.Caller).TopLeftCell
    Do While (EndCell.Borders(xlEdgeBottom).Weight = xlHairline)
        Set EndCell = EndCell.Offset(1)
    Loop
    
    Set Zone = Range(StartCell, EndCell).Offset(, 8)
    Me.Shapes(Application.Caller).TopLeftCell.Resize(, 2).Copy
    
    Set Target = Zone.Find("", Zone.Cells(Zone.Rows.Count), xlValues, SearchDirection:=xlNext)
    If Target Is Nothing Then Set Target = Zone.Find(0, Zone.Cells(Zone.Rows.Count), xlValues, SearchDirection:=xlNext)
    If Not Target Is Nothing Then
        Target.Resize(, 2).PasteSpecial Paste:=xlPasteValues
    Else
        MsgBox "Pas de cellules disponibles dans la zone " & Zone.Address, vbCritical
    End If

End Sub

juju91 · 23 Novembre 2025

Bonjour et merci à tous.

la solution de FANCH55 poste #6 est parfaite .

il y a juste un petit problème, désolé.
Les cellules copiées sont celles au dessus de la cellule active.
J'aurais souhaité que ce soit la cellule active et adjacente a droite qui soient copiés.
Encore désolé mais je n'arrive pas a modifier le code, pourriez-vous de donner un peu d'aide.

Encore un grand merci, de prendre du temps pour mes demandes.

Cdt

fanch55 · 24 Novembre 2025

fanch55 à dit:
Me.Shapes(Btn_Name).TopLeftCell.Resize(, 2).Copy

Le code fourni copie la cellule se trouvant sous le bouton "Copie_Bar"avec la cellule adjacente à droite de celle-ci .

juju91 à dit:
il y a juste un petit problème, désolé.
Les cellules copiées sont celles au dessus de la cellule active.
J'aurais souhaité que ce soit la cellule active et adjacente a droite qui soient copiés.

Vous voulez dire que lorsque vous cliquez sur le bouton "COPIE_BAR",
vous voulez copier la cellule de la colonne B sur la même ligne que la sélection , cette dernière pouvant être n'importe où ?
Dans ce cas là, à quoi vous servent tous les autres activex de la colonne B ?, le bouton aurait plus sa place à coté de l'activex "Image124"

Voici le code permettant de faire ce que vous décrivez, finalement @gbinforme avait raison , son code aurait pu vous guider .

VB:

Option Explicit
Private Sub COPIE_BAR_Click()

    Dim Target As Range
    Dim Zone As Range: Set Zone = [J74:J78]
    Cells(ActiveCell.Row, "B").Resize(, 2).Copy
    
    Set Target = Zone.Find("", Zone.Cells(Zone.Rows.Count), LookIn:=xlValues, searchdirection:=xlNext)
    If Target Is Nothing Then Set Target = Zone.Find(0, Zone.Cells(Zone.Rows.Count), LookIn:=xlValues, searchdirection:=xlNext)
    
    If Not Target Is Nothing _
    Then Target.Resize(, 2).PasteSpecial Paste:=xlPasteValues _
    Else MsgBox "Pas de celulles disponibles dans la zone " & Zone.Address, vbCritical

End Sub

juju91 · 27 Novembre 2025

Bonjour

Merci beaucoup, c'est parfait

Cdt

Microsoft 365 Première cellule vide ou égal zéros dans une plage définie

juju91

XLDnaute Junior

Pièces jointes

fanch55

sousou

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

gbinforme

XLDnaute Impliqué

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

gbinforme

XLDnaute Impliqué

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

juju91

XLDnaute Junior

fanch55

XLDnaute Barbatruc

juju91

XLDnaute Junior

Discussions similaires

Microsoft 365 Première cellule vide ou égal zéros dans une plage définie

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency