Exécuter deux macros en suivant

Exécuter deux macros en suivant - VB/VBA/VBS - Programmation

Marsh Posté le 19-06-2013 à 15:10:29    

Bonjour,
 
Je suis pas très bon en programmation VBA sous excell.
 
Je travaille actuellement sur fichier d'analyse de données.
Mes macros fonctionnent toute indépendamment les unes des autres mais quand je veux les exécuter en suivant il y a un bug.
J'ai bien trouvé une solution mais elle ne fonctionne que pour un cas précis.
 

Code :
  1. Sub Bilan_1()
  2. Sheets("EVRC - Semi-quantitatif" ).Activate
  3. Range("A4:A6" ).Copy
  4. Sheets("BILAN EVRC" ).Activate
  5. Range("A4:A6" ).PasteSpecial
  6. Sheets("EVRC - Semi-quantitatif" ).Activate
  7. Range("A22" ).Copy
  8. Sheets("BILAN EVRC" ).Activate
  9. Range("A8" ).PasteSpecial
  10. End Sub
  11. _________________________________________________________________
  12. Sub Bilan_2()
  13. Dim i As Integer
  14. Dim j As Integer
  15. Dim k As Integer
  16. k = 2
  17. i = 1
  18. While Sheets("EVRC - Semi-quantitatif" ).Cells(8, i) <> Empty
  19. i = i + 1
  20. Wend
  21. For j = 2 To i
  22. If Sheets("EVRC - Semi-quantitatif" ).Cells(22, j) = "Niveau 0" Or Sheets("EVRC - Semi-quantitatif" ).Cells(22, j) = "Niveau 1" Then
  23. Sheets("EVRC - Semi-quantitatif" ).Activate
  24. Sheets("EVRC - Semi-quantitatif" ).Range(Cells(4, j), Cells(6, j)).Copy
  25. Sheets("BILAN EVRC" ).Activate
  26. Sheets("BILAN EVRC" ).Range(Cells(4, k), Cells(6, k)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  27.         :=False, Transpose:=False
  28.   k = k + 1
  29.    End If
  30.   Next j
  31. End Sub
  32. _________________________________________________________________
  33. Sub bilan_3()
  34. Dim i As Integer
  35. Dim j As Integer
  36. Dim k As Integer
  37. k = 2
  38. i = 1
  39. While Sheets("EVRC - Semi-quantitatif" ).Cells(8, i) <> Empty
  40. i = i + 1
  41. Wend
  42. For j = 2 To i
  43. If Sheets("EVRC - Semi-quantitatif" ).Cells(22, j) = "Niveau 0" Or Sheets("EVRC - Semi-quantitatif" ).Cells(22, j) = "Niveau 1" Then
  44. Sheets("EVRC - Semi-quantitatif" ).Activate
  45. Sheets("EVRC - Semi-quantitatif" ).Range(Cells(22, j), Cells(22, j)).Copy
  46. Sheets("BILAN EVRC" ).Activate
  47. Sheets("BILAN EVRC" ).Range(Cells(8, k), Cells(8, k)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
  48.         , SkipBlanks:=False, Transpose:=False
  49.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  50.         :=False, Transpose:=False
  51.   k = k + 1
  52.    End If
  53.   Next j
  54. End Sub
  55. _________________________________________________________________
  56. Sub BILAN_EVRC_1()
  57. Call Bilan_1
  58. Call Bilan_2
  59. Call bilan_3
  60. End Sub
  61. _________________________________________________________________
  62. Sub Bilan_4()
  63. Dim l As Integer
  64. Dim m As Integer
  65. Dim n As Integer
  66. n = 8
  67. l = 1
  68. While Sheets("EVRC - Quantitatif" ).Cells(8, l) <> Empty
  69. l = l + 1
  70. Wend
  71. For m = 2 To l
  72. If Sheets("EVRC - Quantitatif" ).Cells(10, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif" ).Cells(10, m) = "Niveau 3" Then
  73. Sheets("EVRC - Quantitatif" ).Activate
  74. Sheets("EVRC - Quantitatif" ).Range(Cells(4, m), Cells(6, m)).Copy
  75. Sheets("BILAN EVRC" ).Activate
  76. Sheets("BILAN EVRC" ).Range(Cells(4, n), Cells(6, n)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  77.         :=False, Transpose:=False
  78.   n = n + 1
  79.    End If
  80.   Next m
  81. End Sub
  82. _________________________________________________________________
  83. Sub bilan_5()
  84. Dim l As Integer
  85. Dim m As Integer
  86. Dim n As Integer
  87. n = 8
  88. l = 1
  89. While Sheets("EVRC - Quantitatif" ).Cells(8, l) <> Empty
  90. l = l + 1
  91. Wend
  92. For m = 2 To l
  93. If Sheets("EVRC - Quantitatif" ).Cells(10, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif" ).Cells(10, m) = "Niveau 3" Then
  94. Sheets("EVRC - Quantitatif" ).Activate
  95. Sheets("EVRC - Quantitatif" ).Range(Cells(10, m), Cells(10, m)).Copy
  96. Sheets("BILAN EVRC" ).Activate
  97. Sheets("BILAN EVRC" ).Range(Cells(8, n), Cells(8, n)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
  98.         , SkipBlanks:=False, Transpose:=False
  99.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  100.         :=False, Transpose:=False
  101.   n = n + 1
  102.    End If
  103.   Next m
  104. End Sub
  105. _________________________________________________________________
  106. Sub bilan_6()
  107. Dim l As Integer
  108. Dim m As Integer
  109. Dim n As Integer
  110. n = 8
  111. l = 1
  112. While Sheets("EVRC - Quantitatif" ).Cells(8, l) <> Empty
  113. l = l + 1
  114. Wend
  115. For m = 2 To l
  116. If Sheets("EVRC - Quantitatif" ).Cells(10, m) = "Niveau 2" Or Sheets("EVRC - Quantitatif" ).Cells(10, m) = "Niveau 3" Then
  117. Sheets("EVRC - Quantitatif" ).Activate
  118. Sheets("EVRC - Quantitatif" ).Range(Cells(16, m), Cells(16, m)).Copy
  119. Sheets("BILAN EVRC" ).Activate
  120. Sheets("BILAN EVRC" ).Range(Cells(9, n), Cells(9, n)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
  121.         , SkipBlanks:=False, Transpose:=False
  122.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  123.         :=False, Transpose:=False
  124.   n = n + 1
  125.    End If
  126.   Next m
  127. End Sub
  128. _________________________________________________________________
  129. Sub BILAN_EVRC_2()
  130. Call Bilan_4
  131. Call bilan_5
  132. Call bilan_6
  133. End Sub
  134. _________________________________________________________________
  135. Sub BILAN_EVRC()
  136. Call BILAN_EVRC_1
  137. Call BILAN_EVRC_2
  138. End Sub


 
 
Avec ce code les données copier sont collées comme je le souhaite mais j'impose la colonne à partir d’où s'exécute "BILAN_EVRC_2" "n=8".
 
Et je souhaiterais  que n = k . En résumé que "BILAN_EVRC_2" copie les données juste aprés celles copier par "BILAN_EVRC_1".
 
Merci pour votre aide.

Reply

Marsh Posté le 19-06-2013 à 15:10:29   

Reply

Marsh Posté le 19-06-2013 à 15:54:00    

 
           Bonjour,    suite ici …
 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed