Copier après une sélection de plusieur lignes

[SEBDEBAZ]

Bonjour, je voudrais pouvoir copier les lignes sélectionnées à l'aide de ce code :

Sub test2()
'***Pour sélectionner les lignes correspondant au critère.
Dim Plage As Range, c As Range
Dim lig As String
With ActiveSheet.Range("B1:B" & Range("B65500").End(xlUp).Row)

    Set c = .Find("d_")
    If Not c Is Nothing Then
        firstAddress = c.Address
        lig = c.Row & ":" & c.Row
        Do
            Set c = .FindNext(c)
            lig = lig & "," & c.Row & ":" & c.Row
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
ActiveSheet.Range(lig).Select
End Sub

Ce code me permet de sélectionner les lignes contenant un "d_" dans la colonne B mais je ne peut pas faire de "Selection Copy"

Quelqu'un peut-il m'aider? Merci .

 

[jul51]

Re : Copier après une sélection de plusieur lignes

hello,

Peut etre un truc du style :

Range(lig).Copy

et ensuite:

Range("x:x").PasteSpecial (xlPasteFormats)

Par exemple (ou directement avec la destination apres copy)

J'ai pas testé mais cela doit fonctionner je pense.


Jul

 

[Compte Supprimé 979]

Re : Copier après une sélection de plusieur lignes

Salut Sebdebaz,

Il faut faire une petite modification dans ton code, sinon tu as effectivement une erreur lors de la tentative de copie 😉

Sub test2()
'***Pour sélectionner les lignes correspondant au critère.
Dim Plage As Range, c As Range, FirstAddress
Dim lig As String
With ActiveSheet.Range("B1:B" & Range("B65500").End(xlUp).Row)
    Set c = .Find("d_")
    If Not c Is Nothing Then
        FirstAddress = c.Address
        lig = c.Row & ":" & c.Row
        Do
            Set c = .FindNext(c)
            [COLOR=green]' Pour ne pas reprendre la première addresse[/COLOR]
            [B][COLOR=blue]If c.Address <> FirstAddress Then[/COLOR]
[/B]              lig = lig & "," & c.Row & ":" & c.Row
            [B][COLOR=blue]End If
[/COLOR][/B]        Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If
End With
ActiveSheet.Range(lig).Copy
' ... collage ensuite
End Sub

A+

 

[SEBDEBAZ]

Re : Copier après une sélection de plusieur lignes

Merci infiniment BrunoM45 et jul51,

C'était bien çà.

A bientôt sur le forum