Bonjour à tous.

Voila quelques années que je n'ai plus fait de VBA et j'ai une macro à créer pour mon job.

J'ai un tableau 3:n (col:row), contenant les infos suivantes :

Col1 Col2 Col3
Ligne1 proj1 essai nombre1
Ligne2 proj2 essai nombre2
...
LigneN projN essai nombreN

projN = nom d'un projet
essaiN = nom de l'essai
nombreN = nombre d'essais

Je veux que pour chaque Ligne, je crée une boucle FOR en fonction du nombre d'essais et je concatène le résultat sur une nouvelle feuille existante en collant :

Col1
Ligne1 proj1/essai-1
Ligne2 proj1/essai-2
...
LigneNombre1 proj1/essai-Nombre1
LigneSuivante proj2/essai-1
...
LigneSuivante+Nombre2 proj2/essai-Nombre2
...
LigneN projN/essai-1
LigneN+NombreN projN/essai-NombreN

Je vous présente mon code actuel qui effectue le copier-coller-concaténer pour la première ligne (et les suivante) mais ne permet pas de créer pour chaque ligne de la feuille1 plusieurs lignes sur la feuille 2.

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
Sub Macro1()
  '
  ' Déclaration des variables
  '
  Dim Num As Integer
  Dim NbRow As Integer
  Dim Label As String
  Dim Proj As String
  Dim Element As String
  Dim NewLabel As String
  Dim i As Integer
  '
  ' Sélectionner les cellules adjacentes à la sélections si elle ne sont pas vides
  '
  Sheets("Sheet1").Select
  '
  ' Compter le nombre de lignes à copier et chercher le nombre d'éléments
  '
  Num = Range("C3").End(xlUp).Value
  NbRow = ActiveCell.CurrentRegion.Rows.Count
  '
  ' Attribue les valeurs aux variables
  '
  Label = Range("A1").Value
  Proj = Range("B1").Value
  Element = Num
  NewLabel = Label & "/" & Proj & "-" & Num
  '
  ' Sélectionner les cellules adjacentes à la sélections si elle ne sont pas vides
  '
  Range("A1").Select
  '
  ' Copier les cellules sélectionnées
  '
  ActiveCell.CurrentRegion.Copy
  '
  ' Coller les cellules sur la deuxième feuille
  '
  Sheets("Sheet2").Select
  Range("A1").Select
  '
  ' [DEBUG]Afficher le résultat dans une MsgBox
  '
  MsgBox NewLabel
  '
  ' Coller le résultat en lignes tant que le nombre n'est pas atteint
  ' A CREER !!!
  '
  ActiveCell.PasteSpecial (xlPasteAll)
  Sheets("Sheet2").Range("A1").Value = NewLabel
  Sheets("Sheet2").Range("B1:C1").Value = ""
  '
  '
  '
End Sub
Merci d'avance pour votre aide...

P.S. je travaille sur Excel 2000 EN-US