Copier/coller avec décalage plage de cellule

Bonjour à tous,

Je cherche depuis quelque temps sans succés un code fonctionnel me permettant : sur n'importe quelle feuille de mon fichier, si les cellules "ANTERIEUR" et "CUMUL" sont présentes, alors copier la plage commençant une celulle en dessous de "ANTERIEUR" jusqu'à 50 cellules en dessous, et la coller une cellule en dessous de "CUMUL".

La première partie semble marcher mais j'ai un probléme persistant au moment de la copie.

Merci beaucoup pour votre aide.

Maxime

 For Each ws In Worksheets
        Set sel1 = Nothing
        Set sel2 = Nothing
        On Error Resume Next
        Set sel1 = ws.Range("ANTÉRIEUR") 'vérifie si une cellule nommée ANTÉRIEUR est présente sur la feuille ws
        Set sel2 = ws.Range("CUMUL") 'vérifie si une cellule nommée CUMUL est présente sur la feuille ws
        On Error GoTo 0

        If Not (sel1 Is Nothing Or sel2 Is Nothing) Then
        Dim Début As Integer
        Dim Fin As Integer
        Dim Début2 As Integer
        Début = ws.Range("ANTÉRIEUR").Offset(1, 0)
        Fin = ws.Range("ANTÉRIEUR").Offset(150, 0)
        Début2 = ws.Range("CUMUL").Offset(1, 0)
            ws.Range("Début:Fin").Copy
            ws.Range("Début2").PasteSpecial Paste:=xlPasteValues
        End If
    Next

Bonjour,

Essayez ce code :

Sub Test()

Dim Ws As Worksheet
Dim Sel1 As Range, Sel2 As Range

    For Each Ws In Worksheets
        Set Sel1 = Ws.Range("ANTÉRIEUR") 'vérifie si une cellule nommée ANTÉRIEUR est présente sur la feuille ws
        Set Sel2 = Ws.Range("CUMUL") 'vérifie si une cellule nommée CUMUL est présente sur la feuille ws
        If Not (Sel1 Is Nothing And Sel2 Is Nothing) Then
           Range(Sel1.Offset(1, 0), Sel1.Offset(150, 0)).Copy
           Sel2.Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        End If
        Set Sel1 = Nothing: Set Sel2 = Nothing
    Next

End Sub

Merci beaucoup pour votre aide.

Le bout de code fonctionne parfaitement lorsque j'essaye sur un nouveau fichier, mais plante systématiquement dans mon fichier projet qui comporte d'autres fonctions.

J'ai placé le code dans une fonction dédiée et j'ai une erreur 1004 : Méthode 'Range' de l'objet '_Worksheet' a échoué au niveau de la ligne Set Sel1 = Ws.Range("ANTÉRIEUR"). Avez-vous une idée du problème ?

Merci encore.

Quel est votre code ?

Le mieux serait de mettre votre fichier en ligne.

Bonjour, désolé, j'avais des informations à nettoyer sur mon fichier avant de pouvoir le poster.

En feuille "Tableau de bord", le bouton "nouvelle période de répartition" en haut à gauche lance la fonction.

Les cellules "Antérieur" et "Cumul" se trouvent en feuille "décompte général" et "matrice décompte auteur".

Merci pour votre aide,

Maxime

Essayez :

Sub Nouvelle_période()

Dim I As Integer, NbNoms As Integer
Dim Ws As Worksheet
Dim Ant As Range, Cum As Range

    For Each Ws In Worksheets
        With Ws
             NbNoms = 0
             If .Names.Count > 0 Then
                For I = 1 To .Names.Count
                    ' Debug.Print .Names(I).Name ' & " : " & Ws.Names.Count
                    Select Case .Names(I).Name
                           Case "'" & .Name & "'!ANTÉRIEUR", "'" & .Name & "'!CUMUL"
                                NbNoms = NbNoms + 1
                    End Select
                Next I
                If NbNoms = 2 Then
                   Set Ant = .Range("ANTÉRIEUR") 'vérifie si une cellule nommée ANTÉRIEUR est présente sur la feuille ws
                   Set Cum = .Range("CUMUL") 'vérifie si une cellule nommée CUMUL est présente sur la feuille ws
                   If Not Ant Is Nothing And Not Cum Is Nothing Then
                      Range(Cum.Offset(1, 0), Cum.Offset(150, 0)).Copy
                      Ant.Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                      Debug.Print Ws.Name & ", " & Ant.Address & ", " & Cum.Address
                   End If
                   Set Ant = Nothing: Set Cum = Nothing
                End If
           End If
       End With
    Next

'modifie le nombre de décompte
Worksheets("Tableau de bord").numérodécompte.Value = Worksheets("Tableau de bord").numérodécompte.Value + 1

End Sub

Cela fonctionne, merci infiniment !

Pour ma compréhension, quel était le probléme du code initial ?

Merci encore et bonne journée,

Maxime

J'ai dû aller vérifier la présence des zones nommées dans les onglets, celles-ci pouvant être définies au niveau du classeur ou au niveau d'un onglet.