Discussion :

[nunnu27]

Bonjour a tous.

Je viens vers vous car je suis comme qui dirais "bloqué"...
Je vous explique mon problème:

J'ai des cellules (F10:F59,I10:I59,L10:L59,O10:O59, R10:R59) qui ont comme valeur "0".
Je voudrais que lorsque une de ces cellules (et/ou plusieurs d'ailleurs) soit/soient différente(s) de "0"; pouvoir copier la première cellule de la ligne (donc "A10" dans le cas de la ligne 10) ainsi que la cellule "2 fois sur la gauche" (donc "G10" dans le cas de la cellule "I10"<>"0").

J'ai donc commencé mon bout de code mais des erreurs sont generés...
De plus, un de mes problemes est de pouvoir incrementer vers le bas les copies sur la nouvelles feuilles afin que pour chaque ligne ayant une ou plusieurs cellule <>0 cela génère une nouvelle ligne sur la nouvelle feuille .

Je conçois que ce n'est pas très clair alors voici un exemple concret:
Si "I10" <>0 alors je copie la valeur de "A10" dans "A1" de la nouvelle feuille, et je copie la valeur de "G10" dans "A5" de la nouvelle feuille également.

Puis, si "F15"<>O alors je copie la valeur de "A15" dans "A2" de la nouvelle feuille , et je copie la valeur de "D15" dans "A5" de la nouvelle feuille également.

Voici donc mon problème...

Voici le code que j'ai fais mais qui est "capricieux" car j'utilise des fonctions que je ne maitrise pas forcement...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sheets("1 à 25").Select
Range(Selection, Selection.End(xlDown)).Select
Set Plage = Range("A10:A59")
For Each Cellule In Plage
If Selection.Offset(0, 8).Paste <> 0 Then
Range(Cellule, Cellule.Offset(0, -8)).Copy
Sheets("resume").Select
Range("A10").Activate
Do
ActiveCell.Offset(1, 0).Activate
Loop Until IsEmpty(ActiveCell)
ActiveSheet.Paste
End If
Next Cellule

J'ai fais ce code juste pour la copie de la colonne A si une cellule de la colonne F est <> de 0, et j'ai déjà la tripoté d'erreurs....voici donc pourquoi je viens vers vous.
Mon experience du VBA est toute récente et par conséquent mes connaissances trop "légère"...

Ainsi je viens vers vous pour vous demander votre aide.

Merci d'avance pour vos commentaires.

n.b: ce n'est peut-être pas très clair alors n'hésitez pas a me relancer...

Cordialement

[nunnu27]

Re,

Bon, j'ai amélioré mon code mais le problème est que je n'arrive pas a sélectionner la cellule de référence dans la nouvelle feuille.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sheets("1 à 25").Select
Set Plage = Range("A10:A59")
For Each Cellule In Plage
If Cellule.Offset(0, 8) <> 0 Then
Cellule.Offset(0, 6).Select
Cellule.Offset(0, 6).Copy
 
Do
Range("A1").Select '-->c'est ici que ça pose problème
ActiveCell.Offset(1, 0).Activate
Loop Until IsEmpty(ActiveCell)
ActiveSheet.Paste
End If
Next Cellule

Merci d'avance pour vos commentaires.

Cordialement

évidement j'ai:

Code :

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

Sheets("resume").Select

avant le "do".

[nunnu27]

Bonjour Mercatog,

Justement non.
Si une ou plusieurs cellules sont différentes de 0 alors cela doit être copié sur la même ligne.

J'ai avancé sur mon code mais j'ai un plantage (probablement car je lui demande d'écraser la précédente cellule).

n.b :un des problèmes étant que les cellules de la ligne 10 et 11 dépendant de la même cellule en A (j'ai fusionné les cellules A10 et A11, etc. pour les suivantes...)

Ce qui signifie que les lignes 10 et 11 doivent être sur la même ligne de la feuille suivante (n.b:en pièce jointe l'image du tableau sur un Word, ce sera plus clair je pense...).

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub resumer()
 
'----------------------------
    Sheets("1 à 25").Select
Set Plage = Range("A10:A59")
For Each Cellule In Plage
If Cellule.Offset(0, 5) <> 0 Then
Cellule.Offset(0, 0).Select
Cellule.Offset(0, 0).Copy
    Sheets("resume").Select
Do
ActiveCell.Offset(2, 0).Activate
Loop Until IsEmpty(ActiveCell)
ActiveSheet.Paste
End If
Next Cellule
 
    Sheets("1 à 25").Select
Set Plage = Range("A10:A59")
For Each Cellule In Plage
If Cellule.Offset(0, 5) <> 0 Then
Cellule.Offset(0, 3).Select
Cellule.Offset(0, 3).Copy
    Sheets("resume").Select
Do
ActiveCell.Offset(0, 2).Activate
Loop Until IsEmpty(ActiveCell)
ActiveSheet.Paste
End If
Next Cellule
 
'--------------------------------
    Sheets("1 à 25").Select
Set Plage = Range("A10:A59")
For Each Cellule In Plage
If Cellule.Offset(1, 5) <> 0 Then
Cellule.Offset(0, 0).Select
Cellule.Offset(0, 0).Copy
    Sheets("resume").Select
Do
ActiveCell.Offset(0, 0).Activate '--> bug ici je pense
Loop Until IsEmpty(ActiveCell)
ActiveSheet.Paste
End If
Next Cellule
 
    Sheets("1 à 25").Select
Set Plage = Range("A10:A59")
For Each Cellule In Plage
If Cellule.Offset(1, 5) <> 0 Then
Cellule.Offset(1, 3).Select
Cellule.Offset(1, 3).Copy
    Sheets("resume").Select
Do
ActiveCell.Offset(0, 3).Activate
Loop Until IsEmpty(ActiveCell)
ActiveSheet.Paste
End If
Next Cellule
 
 
End Sub

Merci de prendre du temps pour résoudre mes difficultés.

Cordialement.

[mercatog]

essaies comme ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub resumer()
Dim i As Byte
 
For i = 10 To 59 Step 2
    If Sheets("1 à 25").Range("F" & i).Value <> 0 Then
        With Sheets("resume")
            Sheets("1 à 25").Range("A" & i).Copy .Cells(Rows.Count, 1).End(xlUp)(2).Paste
        End With
    End If
Next i
End Sub