Fusion et bordure

Sub MiseAJourTableau1()
    Dim wsListe As Worksheet
    Dim table As ListObject
    Dim ws As Worksheet
    Dim bureauValue As String
    Dim materialValue As String
    Dim quantityValue As Variant
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim i As Long
    Dim materialExists As Boolean

    Application.ScreenUpdating = False

    Set wsListe = Worksheets("Liste")
    Set table = wsListe.ListObjects("Tableau1")

    ' Parcourir chaque ligne du tableau
    For i = 1 To table.ListRows.Count
        bureauValue = table.ListColumns("Bureau").DataBodyRange.Cells(i, 1).Value
        materialValue = table.ListColumns("Matériel").DataBodyRange.Cells(i, 1).Value
        quantityValue = table.ListColumns("Quantité").DataBodyRange.Cells(i, 1).Value

        ' Trouver la feuille correspondant à la valeur de Bureau
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> "Liste" And ws.Name <> "Feuil2" Then
                If ws.Range("B3").Value = bureauValue Then
                    Set targetSheet = ws
                    Exit For
                End If
            End If
        Next ws

        ' Si une feuille correspondante est trouvée
        If Not targetSheet Is Nothing Then
            ' Déprotéger la feuille cible
            targetSheet.Unprotect

            ' Vérifier si le matériel existe déjà
            materialExists = False
            For Each cell In targetSheet.Range("B8:B" & targetSheet.Cells(targetSheet.Rows.Count, 2).End(xlUp).Row)
                If cell.Value = materialValue Then
                    materialExists = True
                    Exit For
                End If
            Next cell

            ' Si le matériel n'existe pas, insérer les valeurs
            If Not materialExists Then
                ' Trouver la première cellule vide après la ligne 7 dans la colonne B
                lastRow = targetSheet.Cells(targetSheet.Rows.Count, 2).End(xlUp).Row
                If lastRow < 7 Then lastRow = 7
                Set cell = targetSheet.Cells(lastRow + 1, 2)

                ' Insérer les valeurs
                cell.Value = materialValue
                cell.Offset(0, 4).Value = quantityValue

                ' Fusionner les cellules de B à E
                With targetSheet.Range(targetSheet.Cells(cell.Row, 2), targetSheet.Cells(cell.Row, 5))
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Font.Size = 14
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                End With

                ' Ajouter une bordure autour de la cellule de la colonne F (Quantité)
                With targetSheet.Cells(cell.Row, 6) ' 6 corresponds to column F
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                End With
            End If

            ' Reprotéger la feuille cible
            targetSheet.Protect

            ' Réinitialiser targetSheet pour la prochaine itération
            Set targetSheet = Nothing
        End If

    Next i

    Application.ScreenUpdating = True
End Sub

Bonjour, voici mon code, j'ai un problème à partir de la fusion des celulles. Lorsque j'utilise l'userform pour ajouter une nouvelles valeurs elles ne se mets pas dans la bonne mise en forme dans la feuille cible. Exemple, je mets 79 dans Bureau, Boite dans Matériel et 5 dans Quantité, normalement dans la feuille NET Trementinne Scene, je devrais avoir en dernière ligne Boite 5 avec des bodures et les celulles des colonnes B C D E fusionnée. Merci à toutes personnes qui sauraient me donner un coup de main (ou plutot de code) ;) Alors oui je sais "Vade Retro Satanas" pour la fusion des celulles mais je n'ai pas le choix.

Bonjour Oli,

Sans télécharger ton classeur, tu indiques ceci

Set Cell = targetSheet.Cells(lastRow + 1, 2).

Donc tu as bien ton range initial. D'ailleurs je le noterais Celld pour cellule de départ. Et je ferais Set Cellf = Target Sheet.Cells(lastRow + 1, 5) pour la cellule finale.

Ensuite je modifierais la première ligne du With par

targetSheet.Range(Celld.address & ":" & Cellf.address).merge

merci pour tes conseils, mais cela ne change malheureusement pas mon problèmes.

Petit problème résolu, problème de débutant, 2 macro qui s'exécuter et qui ne se termine pas de la même façon.

Pour marquer le fil comme résolu, utilise le bouton en haut à droite de ton fil.

A+