Microsoft 365 Trouver première colonne vide

[juju91]

Bonjour,
Ma demande va peut être vous paraitre simple ce qui n'est pas le cas pour moi...
Je souhaiterais pouvoir trouver la première colonne vide depuis une cellule défini par un code VBA puis coller une plage de cellules que j'ai au préalablement copié et pour finir, supprimer la plage d'origine.
Cette opération pourra être reproduit plusieurs fois.

Ci-joint un fichier, qui sera surement plus explicite.

Par avance merci.

Cdt

 

[Oneida]

Bonjour,
Vous ne copiez qu'une seule cellule, pas une plage.
"Supprimer la plage": cellule A2, C2 et B6 a effacer le contenu
Oui ou ?

 

[bsalv]

bonjour Oneida, juju91,
ce pense à ceci

Private Sub CommandButton1_Click()
     Dim SH, c, c1, i

     Set SH = Sheets("Feuil1")               'dans cette feuille
     Set c = SH.Range("S26:U44")             'votre exemple, "prestation 1"

     For i = 6 To Columns.Count - c.Column Step 6     'a partir 6 colonnes après la colonne S, cherchez une colonne vide
          Set c1 = c.Offset(, i)             'même plage mais un multiple de 6 vers la droite
          b = WorksheetFunction.CountA(c1) = 0     'cette plage est vide
          If b Then Exit For
     Next

     If Not b Then
          MsgBox "désolé, colonne ne pas trouvé"
     Else
          c.Copy
          c1.PasteSpecial Paste:=xlPasteFormats     'copier "formats" de c vers c1
          c1.ClearContents                   'vider c1

          With c1.Cells(1, 1)
               .Value = SH.Range("A2").Value     'la prestation
               With .Offset(, 1)
                    .Value = SH.Range("B6").Value     'remise
                    .Resize(, 3).ColumnWidth = 3     'modifier largeur des 3 colonnes
               End With
          End With

          With SH.Range("A8:A27")            'vos 20 produits
               c1.Cells(2, 1).Resize(.Rows.Count).Value = .Value     'coller leur valeurs
          End With

     End If

End Sub

 

[juju91]

Bonjour
Merci bsalv je vais regarder cela de très prés.

Oneida , en effet je me suis trompé dans mon message. je copie:
en premier la cellule A2 puis la cellule B2 et la cellule B6
avec le code qui est déclenché par le bouton ''sauvegarde''.
ce que je souhaitais, c'était copier la plage de cellule de A8:A27 dans la colonne correspondante( première colonne vide de la ligne 27)

Je n'ai surement pas été très clair dans ma première intervention.

Cdt

 

[Phil69970]

Bonjour à tous

@juju91

ce que je souhaitais, c'était copier la plage de cellule de A8:A27 dans la colonne correspondante( première colonne vide de la ligne 27)

Il y a un pb car la plage destination est plus courte que la plage source

En clair comment tu fais pour mettre la partie entourée dans la partie ou il y a le point d'interrogation ?????

 

[juju91]

bonjour,
En effet, je suis vraiment très C... .
Un autre fichier qui est plus logique..
désolé de vous faire perdre du temps.

 

[fanch55]

Bonjour à tous,
Une proposition de code établi à partir du premier classeur mais qui devrait fonctionner également avec le second

Option Explicit
Private Sub CommandButton1_Click()
Dim Rw As Long, Cel As Range, Target_Row As Long, Cl As Long, Rh As Long
    Target_Row = 27
    ' On cherche la dernière cellule vide en colonne M
    Rw = Cells(Rows.Count, "M").End(xlUp).Row + 1
    If Rw >= Target_Row Then ' on évite les lignes qui ne sont pas sous "OFFRES SITES"
       ' on assigne les valeurs
        Cells(Rw, "M").Resize(, 3) = Array(Cells(2, "A").Value, Cells(2, "B").Value, Cells(6, "B").Value)
       ' plage à transférer : TS_Offre
       ' On cherche la dernière colonne vide en ligne Target_Row
        Cl = Cells(Target_Row, Columns.Count).End(xlToLeft).Column + 1
        If Cl > Columns("P").Column Then
            Cells(Target_Row, Cl).Resize([Ts_Offre].Rows.Count).Value = [Ts_Offre].Value
            Cells(Target_Row, Cl).Resize([Ts_Offre].Rows.Count, 3).HorizontalAlignment = xlCenter
            Cells(Target_Row, Cl).Resize([Ts_Offre].Rows.Count, 3).RowHeight = Rows(Target_Row).Height
            For Each Cel In Cells(Target_Row, Cl).Resize([Ts_Offre].Rows.Count)
                If Not Cel.MergeCells Then Cel.Resize(, 3).Merge
            Next
        End If
    End If
End Sub

 

[Phil69970]

@juju91

Je te propose ce fichier

Merci de ton retour

 

[job75]

Bonjour le forum,

A priori ce n'est pas la plage A8:A27 qu'il faut copier mais la plage M8:M25 :

Private Sub CommandButton1_Click()
Dim titre$, plage As Range, dest As Range
titre = [A2]
Set plage = [M8:M25]
Set dest = [S27] 'cellule de départ
Cells(Rows.Count, dest.Column - 6).End(xlUp)(2) = titre
dest(0) = titre
While dest <> "": Set dest = dest(1, 7): Wend
Set dest = dest.Resize(plage.Rows.Count)
dest.Resize(, 3).HorizontalAlignment = xlCenterAcrossSelection 'mieux qu'une fusion
dest = Evaluate("""Produits " & Trim(Right(titre, 4)) & " ""&" & plage.Address)
End Sub

Il est inutile de fusionner les cellules, il vaut mieux centrer sur plusieurs colonnes.

A+

 

[Phil69970]

Bonjour à tous

@juju91

Tu as eu 3 ou 4 solutions proposées et aucune réponse de ta part !!!!

 

[Phil69970]

@juju91

Tu n'as toujours pas eu le temps de répondre !