Regrouper deux macros

Version imprimable

Bonjour à tous,

Suite à ma derniére questions, (Merci pour vos réponses si rapides) j'ai un tout petit peu progresse en language VBA ;).
Mon problémes est le suivant :
J'ai actuellement 2 macros qui fonctionnent trés bien l'une puis l'autre - "Conclusion" et "Conclusion 2". Les données copier par "Conlusion 2" se collant juste aprés dans celle copier par "Conclusion".

Code de "Conclusion"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Sub Conclusion() Dim i As Integer Dim j As Integer Dim k As Integer k = 2 i = 1 While Sheets("EVRC - Semi-quantitatif").Cells(22, i) <> Empty i = i + 1 Wend For j = 2 To i If Sheets("EVRC - Semi-quantitatif").Cells(22, j) = "Niveau 0" Or Sheets("EVRC - Semi-quantitatif").Cells(22, j) = "Niveau 1" Then Sheets("EVRC - Semi-quantitatif").Activate Sheets("EVRC - Semi-quantitatif").Range(Cells(4, j), Cells(22, j)).Copy Sheets("Conclusion").Activate Sheets("Conclusion").Range(Cells(4, k), Cells(22, k)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False k = k + 1 End If Next j End Sub
Code de "Conclusion 2
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 Sub Conclusion2() Dim l As Integer Dim m As Integer Dim n As Integer k = 2 n = 8 l = 1 While Sheets("EVRC - Quantitatif").Cells(22, l) <> Empty l = l + 1 Wend For m = 2 To l If Sheets("EVRC - Quantitatif").Cells(22, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif").Cells(22, m) = "Niveau 3" Then Sheets("EVRC - Quantitatif").Activate Sheets("EVRC - Quantitatif").Range(Cells(4, m), Cells(28, m)).Copy Sheets("Conclusion").Activate Sheets("Conclusion").Range(Cells(4, n), Cells(28, n)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False n = n + 1 End If Next m End Sub
"

Je souhaiterais que les 2 opérations s'exécutent l'une aprés l'autre en une seule macro.
Dans mon fichier test "Conclusions" copie 6 colonnes, c'est poiurquoi dans "Conclusion 2" n=8.

Je suppose que la soution est simple du genre n= k+1, mais quand jeteste rien ne se passe je dosi oublier quelques détails aui ont leur imortance.

Merci pour votre aide.

Ptitbubu

Hello,

Code:

1
2
3
4
5
 
Sub Conclusion3()
Call Conclusion
Call Conclusion2
End sub

18/06/2013, 10h43
ptitbubu

Merci,

Mais mon n=8 dépend de dunombre de donnée a analysée.
18/06/2013, 10h46
EngueEngue

Très clair comme réponse... Dépend de quelle façon ?
Il te suffira de faire dépéndre ton n de cette dépendance dans le code.
18/06/2013, 10h51
ptitbubu

ALéatoire en fait je ne peux pas le déterminer à l'avance.
La macro "Conclusion" va copier x colonnes deB à x , et la macro "Conclusion 2" va copier y colonnes de x+1 à y.
D'ou mon hypothése que dans "Conclusion "2 n = k+1 (k variable de "Conclusion 1".
18/06/2013, 10h54
EngueEngue
Soit tu fais qqchose de propre. Soit tu bidouilles. Pour bidouiller

A la fin de conclusion tu copies qqpart le nombre X
Au debut de conclusion tu vas chercher ce X et tu fais X+1
Code:

1 2 3 4 5 6 Sub conclusion3() Call conclusion Call conclusion2 'Tu effaces la case ou tu as mis le X End sub

Personnellement je ferai comme ceci

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
Sub Lancer()
 
Call Conclusion(0)
Call Conclusion(2)
End Sub
 
Private Sub Conclusion(ByVal Indice As Byte)
Dim LastCol As Integer, j As Integer
Dim k As Integer
 
With Worksheets("EVRC - Semi-quantitatif")
    LastCol = .Cells(22, .Columns.Count).End(xlToLeft).Column
    For j = 2 To LastCol
        If .Cells(22, j) = "Niveau " & Indice Or .Cells(22, j) = "Niveau " & Indice + 1 Then
            .Range(.Cells(4, j), .Cells(22, j)).Copy
            With Worksheets("Conclusion")
                k = .Cells(4, .Columns.Count).End(xlToLeft).Column + 1
                .Range(.Cells(4, k), .Cells(22, k)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                .Range(.Cells(4, k), .Cells(22, k)).PasteSpecial Paste:=xlPasteValues
            End With
        End If
    Next j
End With
End Sub

18/06/2013, 11h03
EngueEngue

C'est la technique propre. Comme d'habitude Mercator, impressionnant de bonne volonté et de générosité!

Merci pour ta réponse.

Je n'obtiens pas le résultat que je souhaite.
J'ai un modifié mon code, avec mes petites connaissances, pour qu'il soit plus clair. Mais j'ai peut être tout faut.

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
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 
Sub Bilan_1()
 Sheets("EVRC - Semi-quantitatif").Activate
 Range("A4:A6").Copy
 Sheets("BILAN EVRC").Activate
 Range("A4:A6").PasteSpecial
 Sheets("EVRC - Semi-quantitatif").Activate
 Range("A22").Copy
 Sheets("BILAN EVRC").Activate
 Range("A8").PasteSpecial
End Sub
_________________________________________________________________
Sub Bilan_2()
Dim i As Integer
 Dim j As Integer
 Dim k As Integer
 k = 2
 i = 1
 While Sheets("EVRC - Semi-quantitatif").Cells(8, i) <> Empty
 i = i + 1
 Wend
 For j = 2 To i
 If Sheets("EVRC - Semi-quantitatif").Cells(22, j) = "Niveau 0" Or Sheets("EVRC - Semi-quantitatif").Cells(22, j) = "Niveau 1" Then
 Sheets("EVRC - Semi-quantitatif").Activate
 Sheets("EVRC - Semi-quantitatif").Range(Cells(4, j), Cells(6, j)).Copy
 Sheets("BILAN EVRC").Activate
 Sheets("BILAN EVRC").Range(Cells(4, k), Cells(6, k)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  k = k + 1
   End If
  Next j
End Sub
_________________________________________________________________
Sub bilan_3()
Dim i As Integer
 Dim j As Integer
 Dim k As Integer
 k = 2
 i = 1
 While Sheets("EVRC - Semi-quantitatif").Cells(8, i) <> Empty
 i = i + 1
 Wend
 For j = 2 To i
 If Sheets("EVRC - Semi-quantitatif").Cells(22, j) = "Niveau 0" Or Sheets("EVRC - Semi-quantitatif").Cells(22, j) = "Niveau 1" Then
 Sheets("EVRC - Semi-quantitatif").Activate
 Sheets("EVRC - Semi-quantitatif").Range(Cells(22, j), Cells(22, j)).Copy
 Sheets("BILAN EVRC").Activate
 Sheets("BILAN EVRC").Range(Cells(8, k), Cells(8, k)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  k = k + 1
   End If
  Next j
End Sub
_________________________________________________________________
Sub BILAN_EVRC_1()
Call Bilan_1
Call Bilan_2
Call bilan_3
End Sub
_________________________________________________________________
Sub Bilan_4()
Dim l As Integer
 Dim m As Integer
 Dim n As Integer
 n = 8
 l = 1
 While Sheets("EVRC - Quantitatif").Cells(8, l) <> Empty
 l = l + 1
 Wend
 For m = 2 To l
 If Sheets("EVRC - Quantitatif").Cells(10, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif").Cells(10, m) = "Niveau 3" Then
 Sheets("EVRC - Quantitatif").Activate
 Sheets("EVRC - Quantitatif").Range(Cells(4, m), Cells(6, m)).Copy
 Sheets("BILAN EVRC").Activate
 Sheets("BILAN EVRC").Range(Cells(4, n), Cells(6, n)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  n = n + 1
   End If
  Next m
End Sub
_________________________________________________________________
Sub bilan_5()
Dim l As Integer
 Dim m As Integer
 Dim n As Integer
 n = 8
 l = 1
 While Sheets("EVRC - Quantitatif").Cells(8, l) <> Empty
 l = l + 1
 Wend
 For m = 2 To l
 If Sheets("EVRC - Quantitatif").Cells(10, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif").Cells(10, m) = "Niveau 3" Then
 Sheets("EVRC - Quantitatif").Activate
 Sheets("EVRC - Quantitatif").Range(Cells(10, m), Cells(10, m)).Copy
 Sheets("BILAN EVRC").Activate
 Sheets("BILAN EVRC").Range(Cells(8, n), Cells(8, n)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  n = n + 1
   End If
  Next m
End Sub
_________________________________________________________________
Sub bilan_6()
Dim l As Integer
 Dim m As Integer
 Dim n As Integer
 n = 8
 l = 1
 While Sheets("EVRC - Quantitatif").Cells(8, l) <> Empty
 l = l + 1
 Wend
 For m = 2 To l
 If Sheets("EVRC - Quantitatif").Cells(10, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif").Cells(10, m) = "Niveau 3" Then
 Sheets("EVRC - Quantitatif").Activate
 Sheets("EVRC - Quantitatif").Range(Cells(16, m), Cells(16, m)).Copy
 Sheets("BILAN EVRC").Activate
 Sheets("BILAN EVRC").Range(Cells(9, n), Cells(9, n)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  n = n + 1
   End If
  Next m
End Sub
_________________________________________________________________
Sub BILAN_EVRC_2()
 Call Bilan_4
 Call bilan_5
 Call bilan_6
End Sub
_________________________________________________________________
Sub BILAN_EVRC()
 Call BILAN_EVRC_1
 Call BILAN_EVRC_2
End Sub

Je cherche donc une ligne de code qui permette d'exécuter "Bilan_EVRC_2" à partir de la 1er colonne laissé vide par l'exécution de "BILAN_EVRC_1".

Merci pour vos conseil.

20/06/2013, 00h36
EngueEngue

N'étant pas aussi généreux que mercator, je te proppse de rajouter en debut de sub bilan4 une boucle qui va chercjer la derniere case non vide.

Sinon tu m'envois ton doc et tu m'expliques ce que tu veux et je te le fais proprement.