transposer une colonne de liens hypertextes

[Sonia]

Bonjour à toutes et à tous


J'ai une macro qui ajoute une feuille répertoire avec dans la colonne A un lien hypertexte pour toutes les feuilles de mon classeur.

Pour améliorer la présentation et éviter d'avoir une colonne qui n'en finit pas, j'ai transposé cette colonne en 4 colonnes. Bon jusque là pas de pb. Sauf que mes liens hypertextes ne sont plus mais alors plus du tout hypertextes.

Donc comment faudrait il que je fasse ?

Si vous avez une idée ?

Merci par avance
Sonia

 

[ODVJ]

Bonsoir,

comment as-tu réalisé ta 'transposition'?

A+

 

[Sonia]

Bonjour ODVJ

En fait je suis passé par une macro de F.Sigonneau cf ci-joint

Le pb c'est qu'il faut je pense donner l'info comme quoi on manipule des liens hypertextes

style cell.hyperlinks(1).adress mais j'avoue que je ne sais pas l'adapter sur cette macro

macro de F.Sigonneau

Sub TransposeColonneParTranchesDeNLignes()
Dim Arr, NbLignesTranche&, ColonneATransposer&

NbLignesTranche = 4 'à adapter
ColonneATransposer = 1 '(= colonne A) à adapter
With Sheets(Répertoire)
Arr = .Range( _
.Cells(1, ColonneATransposer), _
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, ColonneATransposer) _
).Value
End With
k = 1
Sheets.Add
For i = LBound(Arr, 1) To UBound(Arr, 1) Step NbLignesTranche
For j = 1 To NbLignesTranche
If (i + j - 1) > UBound(Arr, 1) Then Exit For
Cells(k, j).Value = Arr(i + j - 1, 1)
Next
k = k + 1
Next

End Sub 'fs

 

[Sonia]

Bonjour ODVJ

En fait je suis passé par une macro de F.Sigonneau cf ci-joint

Le pb c'est qu'il faut je pense donner l'info comme quoi on manipule des liens hypertextes

style cell.hyperlinks(1).adress mais j'avoue que je ne sais pas l'adapter sur cette macro

macro de F.Sigonneau

Sub TransposeColonneParTranchesDeNLignes()
Dim Arr, NbLignesTranche&, ColonneATransposer&

NbLignesTranche = 4 'à adapter
ColonneATransposer = 1 '(= colonne A) à adapter
With Sheets(Répertoire)
Arr = .Range( _
.Cells(1, ColonneATransposer), _
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, ColonneATransposer) _
).Value
End With
k = 1
Sheets.Add
For i = LBound(Arr, 1) To UBound(Arr, 1) Step NbLignesTranche
For j = 1 To NbLignesTranche
If (i + j - 1) > UBound(Arr, 1) Then Exit For
Cells(k, j).Value = Arr(i + j - 1, 1)
Next
k = k + 1
Next

End Sub 'fs

 

[Sonia]

En fait le plus simple est je pense de vous faire passer un petit fichier récapitulant exactement la mise en forme que je veux.

En espèrant que quelqu'un aura la solution. 🙁 [file name=transposeliens.zip size=2103]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/transposeliens.zip[/file]

 

[ODVJ]

test