Où est le problème dans ce code

**alidroos** · 24/12/2011, 11h47

Bonjour

S 'il vous plaît examiner ce code où le problème

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
Public Sub al_TQREER_ALL()
Dim A As Long
Dim C As Range, D As Range, F As Range, Q
For R = 4 To Cells(Rows.Count, 5).End(xlUp).Row
If Cells(R, 5).Value <> Empty Then
If Cells(R, 5).Value = "Nouveau" Then
Set C = Range("B4:B" & R)
Set D = Range("D4:D" & R)
Set F = Range("AL4:AQ" & R)
Set Q = Range("AT4:AT" & R)
Set XXX = Union(C, D, F, Q)
Application.ScreenUpdating = False
Range("B" & XXX).Copy
With Worksheets(2)
ZZ = .Cells(1000, 2).End(xlUp).Row + 1
.Range("B" & ZZ).PasteSpecial xlPasteValues
.Application.CutCopyMode = False
.Application.ScreenUpdating = True
End With
End If
End If
Next R
End Sub

S'il vous plaît aider

**Daniel.C** · 24/12/2011, 12h22

Bonjour,

Oui, mais quel est le problème ? Une erreur, un comportement non prévu ?

**Daniel.C** · 24/12/2011, 12h42

XXX étant une variable de type Range, tu ne peux pas écrire :

Code :

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

Range("B" & XXX).Copy

**mercatog** · 24/12/2011, 13h29

En plus des remarques de Daniel, peut être tu voulais faire

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
Public Sub al_TQREER_ALL()
Dim i As Long, d As Long, NewLig As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
d = 4
With Worksheets("Feuil1")                        'à adapter
    For i = 4 To .Cells(.Rows.Count, 5).End(xlUp).Row
        If .Cells(i, 5).Value = "Nouveau" Then
            Union(.Range("B" & d & ":B" & i), .Range("D" & d & ":D" & i), .Range("AL" & d & ":AQ" & i), .Range("AT" & d & ":AT" & i)).Copy
            With Worksheets(2)
                NewLig = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
                .Range("B" & NewLig).PasteSpecial xlPasteValues
            End With
            .Application.CutCopyMode = False
            d = i + 1
        End If
    Next i
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub