Copier après une sélection de plusieur lignes

SEBDEBAZ · 29 Mai 2007

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

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 · 29 Mai 2007

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 · 29 Mai 2007

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 😉

Code:

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 · 29 Mai 2007

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

Merci infiniment BrunoM45 et jul51,

C'était bien çà.

A bientôt sur le forum

Copier après une sélection de plusieur lignes

SEBDEBAZ

Guest

jul51

Guest

Compte Supprimé 979

Guest

SEBDEBAZ

Guest

Discussions similaires

Copier après une sélection de plusieur lignes

SEBDEBAZ

Guest

jul51

Guest

Compte Supprimé 979

Guest

SEBDEBAZ

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency