1004 Autofill classe Range échoué

Version imprimable

Bonjour,
Je me permets de creer un poste car je rencontre un souci avec la fonction autofill sous excel.
J'ai fait plusieurs tentatives mais rien de fructueux.

Pourriez-vous me porter assistance ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub AutoRemplissage()
    Dim x, s, d As Integer
    Dim Sr, Dr As Range
    Dim Ws As Worksheet
        For x = 3 To 6
            Set Ws = ThisWorkbook.Sheets(x)
            Ws.Select
 
            Range("A2500").Select
            Selection.End(xlUp).Select
            d = ActiveCell.Row
            Set Dr = Ws.Range(Cells(d, 1), Cells(d, 2))
 
            Range("C2500").Select
            Selection.End(xlUp).Select
            s = ActiveCell.Row
            Set Sr = Ws.Range(Cells(s, 1), Cells(s, 2))
 
            'ligne en litige
            Sr.AutoFill Destination:=Dr
            'testé avec
            Range(Sr).AutoFill Destination:=Range(Dr)
 
        Next
End Sub

Merci par avance

Bonsoir,

Ce que tu fais ne peut pas fonctionner, tu veux faire quoi au juste ? Remplir les colonnes A et B jusqu'à la dernière cellule non vide de la colonne C ?
Si c'est le cas, inspire toi de ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub Test()
 
    Dim PlgAB As Range
    Dim Lgn As Long
 
    'pour une incrémentation des valeurs, il faut qu'il y est au moins deux lignes avec des valeurs différentes
    Set PlgAB = Range("A1:B2")
 
    'recherche la dernière ligne non vide en colonne C
    Lgn = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
 
    'puis redimensionne la plage du nombre de lignes et tire vers le bas
    PlgAB.AutoFill PlgAB.Resize(Lgn)
 
End Sub

Bonsoir Theze

Merci pour ton aide, cela fonctionne à merveille.

Ci dessous mon code final.

Cdt

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub AutoRemplissage()
    Dim x, s, d, l As Integer
    Dim Sr, Dr As Range
    Dim Ws As Worksheet
 
        For x = 4 To 7
            Set Ws = ThisWorkbook.Sheets(x)
            Ws.Select
 
            d = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
            s = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            Set Sr = Ws.Range(Cells(s, 1), Cells(s, 2))
            l = d - s + 1
 
            If l > 1 Then
                Sr.AutoFill Sr.Resize(l)
            End If
 
        Next
End Sub