XL 2016 Macro, Copier coller des cellules fusionnées en fonction d'un texte

Pade · 19 Mai 2022

Bonjour-soir à tous,

Grâce à ce forum j'ai pu obtenir une macro permettant de fusionner automatiquement des cellules en fonction du nombre que je rentre dans la colonne D (voir fichier ci-joint), cela marche parfaitement. Maintenant, je suis bloqué autre part. A partir de ce tableau, avec mes cellules fusionnées, je voudrais que lorsque que l'on met "remis" dans une des colonnes, cela me copie automatiquement dans l'autre tableau les cellules fusionnées sur la dernière ligne libre, avant de les supprimer du tableau d'origine. J'arrive à le faire facilement avec des cellules non fusionnées mais avec les cellules fusionnées, cela ne fonctionne pas.
Voici ma formule pour les cellules non fusionnées :

VB:

Private Sub worksheet_change(ByVal target As Range)
Set r = Intersect(target, Columns(12))
If Not r Is Nothing Then
    For Each cell In r
        If cell.Value Like "Remis" Then
            Call CopyRows
            Call deleterow
        End If
    Next cell
End If
End Sub

Macros CopyRows

Code:

Public Sub CopyRows()
    Sheets("Feuille avec code").Select
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
        ThisValue = Cells(x, 12).Value
        If ThisValue = "Remis" Then
            Cells(x, 1).Resize(1, 14).Copy
            Sheets("Feuille ou je veux copier").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Feuille ou je veux copier").Select
        End If
    Next x
    
End Sub

Macros deleterow

Code:

Sub deleterow()


Sheets("Feuille avec code").Select

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

    For x = 2 To FinalRow

        ThisValue = Cells(x, 12).Value

        If ThisValue = "Remis" Then

            Cells(x, 1).EntireRow.Delete

            
        End If

    Next x

    

End Sub

Deadpool_CC · 19 Mai 2022

Naturellement j'aurais fait l'équivalent d'un Couper la ligne / Inserer les celulles coupées

J'ai pas modifié ton code mais avec en ligne 5 des cellules fusionnées, cela insert la ligne avec les mêmes celulles fusionnées

Rows("5:5").Select
Selection.Cut
Rows("19:19").Select
Selection.Insert Shift:=xlDown

et plus besoin d'avoir 2 fonctions pour cela
faut juste dans ton worksheet_change, selectionner la ligne en fonction de ta progression dans ta boucle
et faire le Insert après avoir trouvé la dernière ligne dans ton autre feuille.

XL 2016 Macro, Copier coller des cellules fusionnées en fonction d'un texte

Pade

XLDnaute Nouveau

Pièces jointes

Deadpool_CC

XLDnaute Accro

Discussions similaires