Problème boucle avec double critères (convertir/transposer)

Bonjour à tous !

J'ai petit problème sur une boucle impliquant une conversion et une transposition des valeurs obtenues.

Voilà à quoi ressemble mon code actuellement:

Dim Cell As Range

Sheets("Traitement des données").Select

'Départ de la boucle

For Each Cell In Range("B10:AT10")

Selection.TextToColumns Destination:=Range("G11"), DataType:=xlDelimited, _ 'J'aimerais que G11 passe à H12 et ainsi de suite

TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _

Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _

:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _

Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True

With Range("G11:P11").Select 'J'aimerais sélectionner le résultat de la conversion pour le copier/transposer en G12 et ainsi de suite H12,...

Selection.Copy

Range("G12").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

End With

Next Cell

Mon plus gros problème c'est que je ne sais comment donner la bonne indication pour qu'il comprenne que sur la plage sélectionnée, il doit certes passer d'une cellule à l'autre mais également passer d'une zone de copiage à l'autre.

Merci par avance pour votre aide.

Bonjour,

Bonjour Raja et merci de bien vouloir regarder si tu peux trouver une solution à mon problème.

Tu trouveras ci-joint un fichier "Doc exemple". J'ai essayé de la rendre le plus clair possible pour que tu comprennes bien les différentes problématiques.

Je reste disponible pour toute question.

Bonjour à tous.

Personne ne peut m'aider sur mon problème ?

N'hésitez pas à me demander plus de précisions si nécessaire.

Merci

Bonsoir qap, Raja, le forum

Ai-je bien compris

Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, e, n As Long, m As Long, maxrow As Long
    With [a1].CurrentRegion
        a = .Value
        'attention à la 1ère dimension
        ReDim b(1 To 100, 1 To UBound(a, 2))
        n = 1: m = 1
        For j = 1 To UBound(a, 2)
            b(n, j) = a(1, j)
        Next
        For i = 2 To UBound(a, 1)
            For j = 2 To UBound(a, 2)
                n = m
                For Each e In Split(a(i, j), ",")
                    n = n + 1
                    b(n, 1) = a(i, 1)
                    b(n, j) = e
                Next
                maxrow = Application.Max(n, maxrow)
            Next
            m = maxrow
        Next
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 1).Resize(maxrow, UBound(b, 2))
            .CurrentRegion.Clear
            .Value = b
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            With .Rows(1)
                .Interior.ColorIndex = 36
                .BorderAround Weight:=xlThin
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Raja !

Pardon, mais j'étais absent très longtemps et n'ai pu voir ta réponse. C'est exactement ça merci beaucoup !!

Encore désolé pour le temps de réponse. Je solde le post de suite