Discussion :

[mrah1]

Bonjour,

C'est encore une erreur '1004'. J'ai tourné en rond sur cette erreur qui doit être le lot des débutants.

Je voudrait recopier des plages de cellules d'une feuille "origine" vers une autre feuille "destination" suivant un ordre définie par la série de chiffre de 1 à p dans une plage de la feuille "origine".

Voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
26
Sub RecopieCellule()
 
 
Dim p
Dim nbligne As Integer
Dim numligne As Integer
Dim numlignedest As Integer
Dim priorité As Range
 
    Set priorité = Worksheets("origine").Range("A1:A100")
    nbligne = WorksheetFunction.Max(priorité)
    numlignedest = 8
    Sheets("origine").Activate
 
    For p = 1 To nbligne
    priorité.Cells.Find(What:=p, LookIn:=xlValues).Activate
    numligne = ActiveCell.Row
    With Sheets("origine")
    Sheets("destination").Cells(numlignedest, 4).Value = ActiveCell.Offset(0, 1).Value
    Sheets("destination").Range(Cells(numlignedest, 1), Cells(numlignedest, 3)).Value = .Range(Cells(numligne, 6), Cells(numligne, 8)).Value
    Sheets("destination").Range(Cells(numlignedest, 5), Cells(numlignedest, 7)).Value = .Range(Cells(numligne, 10), Cells(numligne, 12)).Value
    numlignedest = numlignedest + 1
    End With
    Next
 
End Sub

Ca bugg à la ligne

Sheets("destination").Range(Cells(numlignedest, 1), Cells(numlignedest, 3)).Value = .Range(Cells(numligne, 6), Cells(numligne, 8)).Value

avec la fameuse erreur d'exécution '1004'
erreur définie par l'application ou par l'objet

a l'aide!
Merci

[pgz]

Bonjour.

Le problème pourrait bien venir de l'usage sans attachement des Cells. Tu pourrais essayer ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Dim wshO as Excel.worksheet, wshD as Excel.Worksheet
...
Set wshO = Application.Thisworkbook.Worksheets("Origine")
Set wshD = Application.Thisworkbook.Worksheets("destination")
 
...
wshD.Range(.Cells(...),.Cells(...)).value = wshO.Range(.Cells(...),.Cells(...)).Value
 
...
Set wshO = Nothing
Set wshD = Nothing

PGZ

[mrah1]

j'ai modifié mon code comme suit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
26
27
28
29
30
31
32
33
34
Sub RecopieCellule()
 
Dim wshO As Excel.Worksheet, wshD As Excel.Worksheet
 
Set wshO = Application.ThisWorkbook.Worksheets("Origine")
Set wshD = Application.ThisWorkbook.Worksheets("destination")
 
Dim p
Dim nbligne As Integer
Dim numligne As Integer
Dim numlignedest As Integer
Dim priorité As Range
 
    Set priorité = wshO.Range("A1:A100")
    nbligne = WorksheetFunction.Max(priorité)
    numlignedest = 8
    wshO.Activate
 
    For p = 1 To nbligne
    priorité.Cells.Find(What:=p, LookIn:=xlValues).Activate
    numligne = ActiveCell.Row
        With wshO
        wshD.Cells(numlignedest, 4).Value = ActiveCell.Offset(0, 1).Value
        wshD.Range(Cells(numlignedest, 1), Cells(numlignedest, 3)).Value = .Range(Cells(numligne, 6), Cells(numligne, 8)).Value
        wshD.Range(Cells(numlignedest, 5), Cells(numlignedest, 7)).Value = .Range(Cells(numligne, 10), Cells(numligne, 12)).Value
        numlignedest = numlignedest + 1
 
        End With
    Next
 
    Set wshO = Nothing
    Set wshD = Nothing
 
End Sub

j'ai maintenant une autre erreur '1004'
la méthode 'range' de l'objet 'worksheet' à échoué

??

[pgz]

Tu n'as pas tout à fait appliqué ce que je te suggèrais. Essaie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
26
27
28
29
30
31
32
33
34
Sub RecopieCellule()
 
Dim wshO As Excel.Worksheet, wshD As Excel.Worksheet
 
Set wshO = Application.ThisWorkbook.Worksheets("Origine")
Set wshD = Application.ThisWorkbook.Worksheets("destination")
 
Dim p
Dim nbligne As Integer
Dim numligne As Integer
Dim numlignedest As Integer
Dim priorité As Range
 
    Set priorité = wshO.Range("A1:A100")
    nbligne = WorksheetFunction.Max(priorité)
    numlignedest = 8
    wshO.Activate
 
    For p = 1 To nbligne
    priorité.Cells.Find(What:=p, LookIn:=xlValues).Activate
    numligne = ActiveCell.Row
        With wshO
        wshD.Cells(numlignedest, 4).Value = ActiveCell.Offset(0, 1).Value
        wshD.Range(wshD.Cells(numlignedest, 1), wshD.Cells(numlignedest, 3)).Value = .Range(.Cells(numligne, 6), .Cells(numligne, 8)).Value
        wshD.Range(wshD.Cells(numlignedest, 5), wshD.Cells(numlignedest, 7)).Value = .Range(.Cells(numligne, 10), .Cells(numligne, 12)).Value
        numlignedest = numlignedest + 1
 
        End With
    Next
 
    Set wshO = Nothing
    Set wshD = Nothing
 
End Sub

Je ne suis pas sûr d'avoir tout vu.

PGZ

[mrah1]

Ca y est. Merci pgz ! je n'aurais pas trouvé tout seul; Que le chemin est long...