VBA Récopier des cellules en colonne dans des lignes avec des boucles
Bonjour à tous,
Je suis nouveau sur ce forum, et mes connaissances en VBA sont très limités (en gros je suis débutant et je commence à me lancer
Ma problématique est la suivante:
J'ai un fichier avec Xligne, dans celui ci se trouve une société par ligne et 4 contact (Colone jaune/ verte / rouge / orange).
Il faudrait que je puisse éclater sur 4 lignes mes 4 contacts tout en gardant le numéro et nom de société sur chacune des lignes.
Je joins un exemple de un fichier Excel: 1er onglet -> avant 2ème onglet -> Résultat voulu.
J'ai réussi à:
- insérer 3 lignes,
- copier le nom de société sur les 4 première lignes
Mais pas à :
- faire une boucle pour copier jusqu'en bas le nom société
- copier les contact sur ces lignes
Merci par avance pour votre aide.
NB: Mon fichier réel comporte plus de 30 000 lignes, mais le même nombre de colonne.
Jaja38,
Tu trouveras ma proposition en P.J.
Le module contenant le code est intitulé "PropositionGVS".
Bonjour Gérard,
merci beaucoup c'est parfait.
Il me reste à comprendre votre code, mais il est très bien documenté.
A bientôt, cordialement,
Salut l'équipe,
pour le plaisir, la macro démarrant au double-clic en [A1].
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData1, tData2()
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
Cancel = True
iRow = Range("A" & Rows.Count).End(xlUp).Row
ReDim tData2((iRow * 4) - 3, 8)
tData1 = Range("A1:Z" & iRow).Value
'
For x = 1 To UBound(tData1, 1)
If x > 1 Then iLig = iLig + 1
iCol = 0
For y = 1 To IIf(x = 1, 8, 26)
iLig = IIf(y Mod 6 = 3 And y > 3, iLig + 1, iLig)
iCol = IIf(y > 3 And y Mod 6 = 3, Int(y / 6), iCol)
tData2(iLig, y - (iCol * 6) - 1) = tData1(x, y)
Next
Next
With Worksheets("Résultat voulu")
.UsedRange.ClearContents
.Range("A1").Resize((iRow * 4) - 3, 8) = tData2
.Columns("A:I").AutoFit
.Activate
End With
End If
'
End SubA+