Copier des ligne en colonne VBA

Bonjour à tous,

je suis débutant en vba, mais je voudrais écrire un macro qui me permettra de copier un ligne donnée suite à un test d'égalité et de le coller devant une valeur après le test.

Je joins au post un fichier excel pour faire comprendre. La troisième feuille du classeur contient le résultat qu'on attend.

Merci

Bonjour

A tester

Merci Banzai64,

C'est ta proposition marche pour le fichier.

Mais ce que j'ai remarqué ce que tu n'as pas fait de test sur la valeur de _index de la feuille "Appendix" et la valeur de parent_index de la feuille varietes

Bonjour

greg6fr a écrit :

tu n'as pas fait de test sur la valeur de _index de la feuille "Appendix" et la valeur de parent_index de la feuille varietes

Sans doute que les explications dans le fichier n'ont pas indiqué ce test

Et actuellement je ne sais pas exactement ce qu'il faut faire

Tu indiques clairement quel test il faut faire

index de cette feuille est comme la clé primaire et parent_index de la feuille varietes est une clé etrangere .

Donc nous voudrions faire correspondre à clé primaire (ici index) toutes les valeurs de la feuille varietes qui le concernent en faisant un test d'égalité sur le champ parent_index de la feuille varietes

Voir résultat que l'on souhaite avoir sur la feuille : "Résultat attendu"

Bonjour

A tester

Bonsoir Banzai64,

Merci bien, le macro marche parfaitement bien.

Grand merci a toi

Bonsoir,

Svp je sollicite votre aide pour régler un bug lors de l'execution de mon code.

ça me mets :

Erreur d'éxécution '9' :

L'indice n'appartient pas à la sélection.

Voici le code :

Sub Transpose()
Dim J As Long, Nblg As Long
Dim I As Integer, LeMax As Integer, Colonne As Integer, Indice As Integer
Dim Position As Integer, NbEnCours As Integer
Dim Tablo
  Application.ScreenUpdating = False
  Cells.ClearContents
  Sheets("Appendix").Columns("A").Copy Range("A1")
  With Sheets("rvariety")
    Nblg = .Range("A" & Rows.Count).End(xlUp).Row
    LeMax = WorksheetFunction.Mode(.Range("G2:G" & Nblg))
    Colonne = Application.CountIf(.Range("G2:G" & Nblg), LeMax)
    ReDim Tablo(1 To Colonne * 7, 1 To Sheets("Appendix").Range("A" & Rows.Count).End(xlUp).Row)
    For I = 0 To Colonne - 1
      Tablo(1 + (I * 7), 1) = "rvariety/Q5_variety"
      Tablo(2 + (I * 7), 1) = "rvariety/Q5_hybrid"
      Tablo(3 + (I * 7), 1) = "rvariety/Q5_improved"
      Tablo(4 + (I * 7), 1) = "rvariety/Q5_duration"
      Tablo(5 + (I * 7), 1) = "rvariety/Q5_seeds"
      Tablo(6 + (I * 7), 1) = "rvariety/Q5_other"
      Tablo(7 + (I * 7), 1) = "_parent_index"
    Next I
    Indice = 1
    For J = 2 To Nblg
      For I = 1 To UBound(Tablo) Step 7
        If Tablo(I, 1 + .Range("G" & J)) = "" Then Exit For
      Next I
      Tablo(0 + I, 1 + .Range("G" & J)) = .Range("A" & J)
      Tablo(1 + I, 1 + .Range("G" & J)) = .Range("B" & J)
      Tablo(2 + I, 1 + .Range("G" & J)) = .Range("C" & J)
      Tablo(3 + I, 1 + .Range("G" & J)) = .Range("D" & J)
      Tablo(4 + I, 1 + .Range("G" & J)) = .Range("E" & J)
      Tablo(5 + I, 1 + .Range("G" & J)) = .Range("F" & J)
      Tablo(6 + I, 1 + .Range("G" & J)) = .Range("G" & J)
    Next J
  End With
  Range("B1").Resize(UBound(Tablo, 2), UBound(Tablo)) = Application.Transpose(Tablo)
End Sub

Bonjour

A vérifier