Macro Excel : copier-coller-concaténer

Version imprimable

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:

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

Bonjour (tardif) neo2k2, bienvenue sur le forum.
Je ne vais pas utiliser ton code pour te donner un exemple, tu essaieras de le comprendre pour l'adapter ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim FL1 as worksheet
Dim FL2 as worksheet
Dim i as long, NoLigne as long, NoCol as byte, DerniereLigne as long
    Set FL1 = Worksheets("Sheet1")
    Set FL2 = Worksheets("Sheet2")
    DerniereLigne = FL1.Range("A65535").End(xlUp).Row
    For i = 1 to derniereLigne
         For NoCol = 1 to 3
              NoLigne = NoLigne+1
              FL2.Cells(NoLigne, 1) = FL1.Cells(i,NoCol)
         Next
    Next
    Set FL1 = NoThing
    Set FL2 = Nothing

Tu dis
A+

Merci pour ta réponse... :king:

J'ai complété ce dont j'avais besoin... Je poste ici le code pour le cas où ça pourrait aider quelqu'un dans mon cas (il doit pas y en avoir beaucoup mais bon).

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
Sub CPM()
'
' CPM Macro
' Macro recorded 29.06.2007
' Description : CCPM is a macro to copy-paste and merge cell values.
'
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim i, j As Long, NoLigne As Long, NoCol As Byte, DerniereLigne As Long
Dim Num, Content As String
 
Set FL1 = Worksheets("Sheet1")
Set FL2 = Worksheets("Sheet2")
 
DerniereLigne = FL1.Range("A65535").End(xlUp).Row
  For i = 1 To DerniereLigne
      Num = FL1.Cells(i, 3).Value
           For j = 1 To Num
              NoLigne = NoLigne + 1
            For NoCol = 1 To 3
                  Content = FL1.Cells(i, 1) & "-" & FL1.Cells(i, 2)
                  FL2.Cells(NoLigne, 1) = Content
              Next
          Next
  Next
 
Set FL1 = Nothing
Set FL2 = Nothing
'
End Sub

Encore merci pour ton aide. :yaisse2: