Renseignement sur la construction d'un code qui copie colle

Bonjour ,

le code ci-dessous remplie parfaitement sont job mes je le trouve un peu long

Existe t'il une méthode pour réduire la partie for each

merci pour vos réponse

Sub MAJ_PAU()
Dim plage1 As Range, plage2 As Range, plage3 As Range
Dim c As Variant, x As Integer
 With Sheets("Pau")
        Set plage1 = .Range("p16:p" & .Range("p65000").End(xlUp).Row)
        Set plage2 = .Range("u16:p" & .Range("u65000").End(xlUp).Row)
        Set plage3 = .Range("z16:p" & .Range("z65000").End(xlUp).Row)
    For Each c In plage1
        If c.Value = "3 - Clôturé" Then
                 x = Sheets("HISTORIC").Range("p65000").End(xlUp).Row + 1
                .Rows(c.Row).Copy Sheets("Historic").Range("A" & x)
           If c = "3 - Clôturé" Then c.EntireRow.Delete
        End If
    Next
    For Each c In plage2
        If c.Value = "3 - Clôturé" Then
                 x = Sheets("HISTORIC").Range("p65000").End(xlUp).Row + 1
                .Rows(c.Row).Copy Sheets("Historic").Range("A" & x)
           If c = "3 - Clôturé" Then c.EntireRow.Delete
            End If
    Next
    For Each c In plage3
            If c.Value = "3 - Clôturé" Then
                 x = Sheets("HISTORIC").Range("p65000").End(xlUp).Row + 1
                .Rows(c.Row).Copy Sheets("Historic").Range("A" & x)
           If c = "3 - Clôturé" Then c.EntireRow.Delete
            End If
    Next
        Set plage1 = Nothing
        Set plage2 = Nothing
        Set plage3 = Nothing
    End With
End Sub

Bonsoir, quelque chose comme cela :

Sub MAJ_PAU()
Dim plage As Range
Dim c As Variant, x As Integer
 With Sheets("Pau")
        Set plage = Union(.Range("p16:p" & .Range("p65000").End(xlUp).Row), .Range("u16:p" & .Range("u65000").End(xlUp).Row), .Range("z16:p" & .Range("z65000").End(xlUp).Row))

    For Each c In plage
        If c.Value = "3 - Clôturé" Then
                 x = Sheets("HISTORIC").Range("p65000").End(xlUp).Row + 1
                .Rows(c.Row).Copy Sheets("Historic").Range("A" & x)
                c.EntireRow.Delete
        End If
    Next
        Set plage = Nothing
    End With
End Sub

Mais c'est pas le plus optimisé. On évite un maximum les copié/collé. En vrai, en respesctant cette règle, les fois où les copiés/collés sont obligatoires sont très rares !

Pour copier/coller une plage de cellule, utilise cette méthode et applique là à ton code :

    Dim CopyRange As Range
    Dim PasteRange As Range

    Set CopyRange = ThisWorkbook.Worksheets("TA_FEUILLE").Range("TA_PLAGE") 'La plage de données que tu veux copier
    Set PasteRange = ThisWorkbook.Worksheets("TA_FEUILLE").Range("TA_PLAGE") 'La plage de cellules où tu veux coller
    PasteRange.Value2 = CopyRange.Value2 'Copie /colle les données

    Set CopyRange = Nothing 'Vide la variable - À mettre à la fin de ta macro
    Set PasteRange = Nothing 'Vide la variable - À mettre à la fin de ta macro

merci pour ta réponse je vais appliquée tes conseils

bonne fête de fin d'année

Super !

Merci pyro206 et bonnes fêtes de fin d'année à toi aussi !

Rechercher des sujets similaires à "renseignement construction code qui copie colle"