XL 2019 User Form qui renvoi dans un tableau avec celulle fusionnée

[ciarab8442]

Bonjour à tous

Je vous sollicite de nouveau car j’aimerais ajuster un travail que @Piment a réalisé avec beaucoup de soin .

Je viens de terminer certaines mises en forme et mises à jour.

Dans le UserForm, j’ai pu régler les renvois d’informations sur le nom du client, l’adresse, le code postal, etc. (Qui se réalisé avec un décalage), et effectuer quelques modifications mineures.

Cependant, je souhaiterais que les informations ne soient pas renvoyées dans le bon de livraison, mais dans le bon de livraison1. Pour les mises en forme , je souhaite rester fortement sur le modèle du bon de livraison1
Sachant que la partie du bon de livraison me va bien sur les lignes qui s'automatise. (si ça pouvait se faire le le B

Après quelques recherches et essais, j’ai tenté le code suivant, mais cela ne fonctionne pas correctement.


Est ce que je dois dois-je rester avec un tableau de lignes non fusionnées, sans retour à la ligne automatique, tout en conservant les trois colonnes comme je le souhaite. Ou il y a t'il une autres astuce . Du type chercher le nombre de ligne active (tableau bon de livraison) et de copier de la première à la dernière dans le tableau du bon de livraison 2 et passer par un masquage de ligne pour les lignes non complétées ?

Merci pour votre aide.

---

Public Sub RemplirBonDeLivraison1()
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet
    Dim Tbl As ListObject
    Dim i As Long, destRow As Long
   
    ' Feuilles
    Set wsSrc = ThisWorkbook.Sheets("Bon de Livraison")
    Set wsDest = ThisWorkbook.Sheets("Bon de Livraison1")
   
    '-------------------------------
    '  Supprimer mise en forme et contenu lignes 1 à 12
    With wsDest.Rows("1:12")
        .ClearFormats
        .ClearContents
    End With
   
    '-------------------------------
    '  Écrire les informations principales dans les cellules fusionnées
   
    ' Numéro du Bon de Livraison -> F8:I8
    wsDest.Range("F8:I8").Merge
    wsDest.Range("F8").Value = Me.Txt_NumBon.Value
   
    ' Date -> F9:I9
    wsDest.Range("F9:I9").Merge
    wsDest.Range("F9").Value = Me.Txt_Date.Value
   
    ' Lieu -> F10:I10
    wsDest.Range("F10:I10").Merge
    wsDest.Range("F10").Value = Me.Cbx_Lieu.Value
   
    ' Informations client
    wsDest.Range("P8:U8").Merge
    wsDest.Range("P8").Value = Me.Txt_NomEntreprise.Value
   
    wsDest.Range("P9:U9").Merge
    wsDest.Range("P9").Value = Me.Txt_Adresse.Value
   
    wsDest.Range("P10:U10").Merge
    wsDest.Range("P10").Value = Me.Txt_CodeP.Value & " " & Me.Txt_Ville.Value
   
    '-------------------------------
    ' Transférer le tableau A:G à partir de B13
    Set Tbl = wsSrc.ListObjects("Tbl_BonLivraison")
   
    For i = 1 To Tbl.ListRows.Count
        destRow = 12 + i ' ligne de départ = 13
       
        ' Colonne A -> B:C
        wsDest.Range("B" & destRow & ":C" & destRow).Merge
        wsDest.Range("B" & destRow).Value = Tbl.DataBodyRange.Cells(i, 1).Value
       
        ' Colonne B -> D:E
        wsDest.Range("D" & destRow & ":E" & destRow).Merge
        wsDest.Range("D" & destRow).Value = Tbl.DataBodyRange.Cells(i, 2).Value
       
        ' Colonne C -> F:G
        wsDest.Range("F" & destRow & ":G" & destRow).Merge
        wsDest.Range("F" & destRow).Value = Tbl.DataBodyRange.Cells(i, 3).Value
       
        ' Colonne D -> H:J
        wsDest.Range("H" & destRow & ":J" & destRow).Merge
        wsDest.Range("H" & destRow).Value = Tbl.DataBodyRange.Cells(i, 4).Value
       
        ' Colonne E -> K:L
        wsDest.Range("K" & destRow & ":L" & destRow).Merge
        wsDest.Range("K" & destRow).Value = Tbl.DataBodyRange.Cells(i, 5).Value
       
        ' Colonne F -> N:Q
        wsDest.Range("N" & destRow & ":Q" & destRow).Merge
        wsDest.Range("N" & destRow).Value = Tbl.DataBodyRange.Cells(i, 6).Value
       
        ' Colonne G -> R:S
        wsDest.Range("R" & destRow & ":S" & destRow).Merge
        wsDest.Range("R" & destRow).Value = Tbl.DataBodyRange.Cells(i, 7).Value
    Next i
   
    '-------------------------------
    ' Transférer les informations B19 -> E34 et B20 -> E35
    wsDest.Range("E34").Value = Me.Txt_FonctionResp_Entreprise.Value
    wsDest.Range("E35").Value = Me.Txt_FonctionResp_Destinataire.Value
End Sub

'=======================================================
' Exemple d'appel dans le bouton Valider
'=======================================================
Private Sub Cdb_Valider_Click()
    ' Remplir Bon de Livraison1 avec toutes les infos
    RemplirBonDeLivraison1
   
    MsgBox "Bon de Livraison1 mis à jour avec succès !", vbInformation
End Sub

 

[ciarab8442]

ciarab8442, si ce que vous avez réalisé vous convient, c'est l'essentiel.
Bonne continuation.

@Piment : Je souhaite particuliérement vous remercier pour le temps consacré.

Sans vous.je n'aurais pu aboutir au resultat (et le fichier tourne 98% grace a vos élements)
Je verrai à l'utilisation. J'ai bidouillé 2 ou 3 parties (en.esperant que ca tienne)

Merci pour tous