Fichier d'adresses à transposer

Bonjour,

Je travaille sur des fichiers d'adresses de ce type :

Nom de la société

Adresse

Tél

E-mail

Site

Nom du responsable

saisies les unes en dessous des autres et séparées par une ligne

Je souhaiterais mettre toutes ces infos en colonnes, j'utilise la fonction transposé mais adresse par adresse, y a t-il une fonction, macro ? pour le faire de façon plus rapide ?

Merci pour votre aide

Bonsoir et bienvenue

Tu peux joindre un fichier avec quelques lignes remplies STP ? (5 sociétés par exemple)

A te relire

Amicalement

Nad

Bonjour

Je laisse la Macro à Nad.

Une solution par formules.

https://www.excel-pratique.com/~files/doc/UUK8ZClasseur1.xls

Cordialement

Le voici :

https://www.excel-pratique.com/~files/doc/ex_de_fichier.xls

Merci pour votre réponse, j'aimerai savoir si c'est possible

Re

Ton fichier en retour avec la formule dans la feuille 1 et également dans la feuille 2 (au cas où tu préfèrerais)

Fichier

Amicalement

Nad

Trop fort !!!

Merci beaucoup, et félicitation pour la rapidité !!

Bonsoir,

Je complète le fichier de NAD avec une solution par macro :

Sub Transpose()
'Macro Dan pour Util le 23/02/09 - XL Pratique
Dim i As Byte, col As Byte
Dim lig As Integer
col = 2
i = 1
For lig = 1 To Range("A65536").End(xlUp).Row
If IsEmpty(Cells(lig, 1)) Then i = Range("B65536").End(xlUp).Row + 1: col = 2: lig = lig + 1
If i <= 6 Then
Cells(i, col) = Cells(lig, 1)
End If
col = col + 1
Next
End Sub

Amicalement

Dan

PS : si ton pb est terminé n'oublie pas de mettre RESOLU sur ce fil en reprenant ton premier message et en utilisant la liste déroulante en bas à gauche.

Bonsoir à tous,

Autre macro (pour m'entrainer)

Sub Transpos()
Dim Nb As String
Dim i As Long, j As Long
    Application.ScreenUpdating = False
    Nb = Application.WorksheetFunction.CountA(Range("a:a")) - 1
        For j = 1 To Nb / 6
            For i = 3 To [A65536].End(xlUp).Row
                Range(Cells(i, 1), Cells(i + 5, 1)).Copy
                Cells(j, 2).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                Application.CutCopyMode = False
                i = i + 6
                j = j + 1
            Next i
        Next j
End Sub

Bonne soirée

Claude.

Salut le forum

Une autre version

Sub Transpose_Colonne()
Dim I As Long
Dim Ligne As Long

For I = 3 To [A65536].End(xlUp).Row Step 7
  Range(Cells(I, 1), Cells(I + 5, 1)).Copy
    Cells(Ligne + 1, 2).PasteSpecial Transpose:=True
      Ligne = Ligne + 1
Next I

Application.CutCopyMode = False
Columns("B:G").Columns.AutoFit

End Sub

Mytå

P.S. Claude, attention à ta déclaration de variable Dim Nb As String

Merci Mytå de me corrigé,

Nb As Long était + approprié dans le cas d'une longue liste

le String est plutôt pour une chaine.

For I = 3 To [A65536].End(xlUp).Row Step 7 

ici dans ton code, en fait le Steep 7 incrémente de 7 la variable "I", non ?

et du coup tu supprime une boucle.

Je continue à m'entrainer le + possible pour que çà rentre !

à+....Claude.

Re le forum

For I = 3 To [A65536].End(xlUp).Row Step 7 

Claude, c'est ça donc 3, 10, 17....

Pour un macrotiste de la génération des MacroXL4, tu te débrouilles très bien,

continue dans ta progression.

Mytå

Rechercher des sujets similaires à "fichier adresses transposer"