Transposer un fichier d'adresse
Bonjour à tous,
J'ai récupéré un fichier de plus de 1000 adresses.
Elles sont aujourd'hui rangées en ligne les unes après les autres, cependant à chaque nouvelle adresse il y a une ligne vide.
Ma question est la suivante est-il possible de créer une règle dans le but de transposer automatiquement les adresses après chaque lignes vides.
Vous trouverez en pièce jointe mon fichier excel avec l'exemple.
Je vous remercie d'avance
Thibaud
Bonjour
Au vu des premières données, j'ai défini une transposition par bloc de 5 lignes après avoir supprimé les lignes vides.
Malheureusement, je me suis rendu compte au vu du résultat que tous les blocs n'ont pas 5 lignes et là, je suis coincé.
J'envoie tout de même le fichier pour éventuellement donner une piste, si cela peut être utile.
Cordialement
Merci à vous!
Bonne fin de journée
Bonjour,
Je vous remercie tout d'abord pour la macro que vous m'avez envoyé lors de mon précèdent mail.
J'aimerai savoir si vous savez s'il est possible de creer une macro ayant pour but de transposer automatiquement les adresses a chaque cellule en gras?
Merci d'avance
Thibaud
Bonjour
A vérifier
Edit : Pas le bon fichier
Bonsoir,
Je ne trouve pas le bouton afin de transposer les adresses.
Seul la case 3504A était en gras et non la ligne entière, désolé...
Merci
Bonjour,
Vous est-il possible de transposer les adresses avant chaque cellules en gras (comme dans la version précédente) ?
Merci d'avance
Bon week end
Bonjour
Tu fais un exemple de ce que tu veux
Tu cherches quelque chose ?
3 versions différentes pour récupérer des adresses
Pardon, vous trouverez en pièce jointe le fichier MAJ.
J'ai essayé de me servir du dernier fichier que vous m'avez envoyé mais je n'ai malheureusement pas réussi.
Merci d'avance
Bonjour,
Je ne pense pas qu'ouvrir un nouveau post soit nécessaire pour ma demande...
En effet, serait-il possible à Banzaï64 de commenter le code de la macro que vous avez créée sur ce fichier
svp ?
Car elle correspond à priori à mes besoins, mai je ne sais pas l'adapter au fichier
Merci pour vos commentaires !!
cordialement,
Benjamin
bonjour et bienvenu sur le forum
cela fait quelques jours je ne n'ais pas vu banzai sur le Forum
ci joint son code commenté
a l'avenir ouvre quand même un nouveau post plutôt sur de déterré un vieux
fred
Bonjour,
Merci de m'accueillir !
Bien reçu ! Je créerai au besoin de nouveaux posts !
Un très grand merci en tout les cas !!!
A bientôt ..!!
Re !
Merci pour la rapidité de la réponse !!
Par contre, ccar oui, il en faut un.. : j'ai une erreur d'execution "9" indice n'appartient pas à la selection...
sur cette ligne :
Option Explicit
Sub Regroupe()
Dim Tablo
Dim J As Long, Indice As Long
Dim Colonne As Integer
'fige l'ecran
Application.ScreenUpdating = False
'redefnitla taille de la variable tableau de 1 ligne 8 colonnes
ReDim Tablo(1 To 8, 1 To 1)
'on fait une boucle partant de la ligne 2 a la derniere ligne non vide sur la colonne A
For J = 2 To Range("A" & Rows.Count).End(xlUp).Row
'test si la cellule Aj n'est pas en gras
If Range("A" & J).Font.Bold = False Then
'fait une recherche dans la cellule pour ssavoir si le caractere @ est present
If InStr(1, Range("A" & J), "Code") > 0 Then
'si trouver stock dans la valeur (mail) dans la 7e colonne de variable tableau
Tablo(5, Indice) = Range("A" & J)
'sinon si les premiers 7 caracteres est egale a http://
ElseIf Left(Range("A" & J), 7) = "http://" Then
'stock dans la 8e colonne le site internet
Tablo(8, Indice) = Range("A" & J)
'sinon si les 5 premiers caraceres est différent de fiche
ElseIf Left(Range("A" & J), 5) <> "Fiche" Then
'on va donc stockée succésivement l'adresse puis CP adresse puis tel puis fax d'ou l'incrémentation de colonne
Colonne = Colonne + 1
Tablo(Colonne, Indice) = Range("A" & J)
End If
Else 'si la cellule est en gras
'on incremente le nombre de lignes
Indice = Indice + 1
'redimentionne la variable tableau en préservant les valeurs précédemment stockées la varaible tableau avec une ligne suplémentaire
ReDim Preserve Tablo(1 To 8, 1 To Indice)
'memorise le nom traiter
Tablo(1, Indice) = Range("A" & J)
'reinitialise la variable colonne
Colonne = 1
End If
Next J
'colle le contenu de la variable tableau a partir de cellule E2
Range("E2").Resize(UBound(Tablo, 2), 8) = Application.Transpose(Tablo)
End SubJ'ai pourtant changé les textes recherchés.. N'est-il pas possible de just elui demander de transformer chaque ligne en colonne et un retour à la ligne à chaque cellule en gras ?
Quel est le but de determiner des recherches de "mots clés" ? une meilleure organisation ?
Merci pour ces renseignements !!!
Bonjour,
merci d'ouvrir ton propre sujet en y joignant un classeur xlsx avec les données dans la première feuille et
dans la deuxième la présentation désirée alimentée d'au moins une ligne de données …
Bonjour
Pour le fichier initial, avec un code que certains pourront améliorer, j'en étais là, c'est à dire que je patauge après les spécialités non identifiées parce que le nombre de lignes de chaque Item n'est pas constant, l'idéal pour moi serait, spécialité1, spécialité2, spécialité3, etc...
Sub Transfert()
Application.ScreenUpdating = False
For i = [A65000].End(xlUp).Row To 1 Step -1
If Cells(i, 1) = 0 Then Cells(i, 1).EntireRow.Delete
Next i
'Mise en forme de la ligne de titres
Range("B1").FormulaR1C1 = "No"
Range("C1").FormulaR1C1 = "Nom"
Range("D1").FormulaR1C1 = "Adresse"
Range("E1").FormulaR1C1 = "Code Postal"
Range("F1").FormulaR1C1 = "Ville"
Range("G1").FormulaR1C1 = "Téléphone"
Range("H1").FormulaR1C1 = "Fax"
Range("I1").FormulaR1C1 = "Site Internet:"
Range("J1").FormulaR1C1 = "Spécialité"
Range("K1").FormulaR1C1 = "Spécialté2"
Range("K1").Select
Selection.AutoFill Destination:=Range("K1:N1"), Type:=xlFillDefault
'On parcours la plage de cellules de la colonne A
Dim Cell As Range, J As Long, k As Byte
'On redéfinit la plage de cellules (cette fois sans ligne vide)
For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
'on cherche le numéro de la ligne en gras
For Each Cell In Range("A" & J)
If Cell.Font.Bold = True And Not IsEmpty(Cell) Then BoldCell = BoldCell + 1
Next Cell
k = BoldCell + 1
'on parcourt la plage et si la cellule est en caractères gras on la copie sur la colone Nom
If Range("A" & J).Font.Bold = True Then Range("C" & k) = Range("A" & J)
If Range("A" & J).Value Like "*Adresse*" Then Range("D" & k) = Replace(Range("A" & J).Value, "Adresse", "")
If Range("A" & J).Value Like "*Postal*" Then Range("E" & k) = Replace(Range("A" & J).Value, "Code Postal", "")
If Range("A" & J).Value Like "*Ville*" Then Range("F" & k) = Replace(Range("A" & J).Value, "Ville", "")
If Range("A" & J).Value Like "*Téléphone*" Then Range("G" & k) = Replace(Range("A" & J).Value, "Téléphone", "")
If Range("A" & J).Value Like "*Fax*" Then Range("H" & k) = Replace(Range("A" & J).Value, "Fax", "")
If Range("A" & J).Value Like "*Internet*" Then Range("I" & k) = Replace(Range("A" & J).Value, "Site Internet", "")
If Range("A" & J).Value Like "*Spécialités*" Then Range("J" & k) = Replace(Range("A" & J).Value, "Spécialités", "")
'Traitement des autres spécialités(imparfait)
For L = 1 To 6
If Range("A" & J).Value Like "*Chirurgie*" Then Range("K" & k) = Range("A" & J)
If Range("A" & J).Value Like "*Radiothérapie*" Then Range("L" & k) = Range("A" & J)
If Range("A" & J).Value Like "*enfant*" Then Range("M" & k) = Range("A" & J)
Next L
Next J
End SubCordialement
ça marche ! le voici :
Oups !
Merci amadeus, c'est parfaitement ça !!!!
Merci beaucoup !!!
Désolé dans ce cas d'avoir ouvert un autre post...
Cordialement