• Initiateur de la discussion Initiateur de la discussion lolo0013
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

L

lolo0013

Guest
Bonjour à tous

J’ai besoin d’aide, voici mon problème :
Je viens de reprendre la présidence d’une association, ou toute les fiches des membres (plusieurs centaine) son sous Excel .Le problème est que mon prédécesseur avait créé un fichier Excel par fiche !!!!
Le tous est quasiment inexploitable.
J’aimerai récupérer les donnes des fiches (elles ont toutes le même format) afin de créer un seul et unique fichier Excel sous la forme :
« Nom prénom adresse téléphone email »
« xxx xxxxx xxxxx xxxxxx xxxxx »
« yyy yyyyy yyyyy yyyyyy yyyyy »

Merci d'avance
 
Re : données excel

encore un petit soucis:

malgré les affirmation de mon prédécesseur toute les fiches ne sont pas identique (il a insérer des commentaires donc insertion de lignes) les libellés (nom prénom etc...), sont toujours dans la colonne A mais pas toujours à la même ligne, et les données sont toujours dans la colonne F, je pense que la solution n'est pas compliqué, j'ai compris la logique à appliquer, mais je ne sais pas la traduire en VBA.Peut tu m'aider à nouveau.

merci
 
Re : données excel

Les libéllés sont bien : Nom, Prénom, Adresse, Téléphone, email et Date d'inscription dans chaque fichier ?
La 2ème partie de l'adresse se trouve toujours en-dessous de la 1ere ?
Les données sont toujours en colonne F ?
 
Re : données excel

Je pense que quelque chose du genre devrait faire l'affaire :

Code:
Sub CréeListe()
Dim FSo As FileSearch, Dossier As String, Wkb As Workbook
Dim Nom As String, Prénom As String, Adresse As String, Adresse2 As String, Téléphone As String
Dim Mail As String, DateInsc As Date, Lignes As Long, i As Long
    Dossier = "C:\temp" 'C'est ici que tu devra mettre le chemin de ton dossier
    Set FSo = Application.FileSearch
        With FSo
        .NewSearch
        .LookIn = Dossier
        .Filename = "*.xls"
            If .Execute() > 0 Then
                For i = 1 To .FoundFiles.Count
                   Set Wkb = Workbooks.Open(.FoundFiles(i))
                   Lignes = Wkb.Worksheets("Sheet1").Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Rows.Count
                    For j = 1 To Lignes
                        Select Case Wkb.Worksheets("Sheet1").Range("A" & j).Value
                            Case "Nom"
                                Nom = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "Prénom"
                                Prénom = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "Adresse"
                                Adresse = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                                Adresse2 = Wkb.Worksheets("Sheet1").Range("F" & j + 1).Value
                            Case "Téléphone"
                                Téléphone = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "email"
                                Mail = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "Date d'inscription"
                                DateInsc = CDate(Wkb.Worksheets("Sheet1").Range("F" & j).Value)
                        End Select
                    Next j
                   Wkb.Close False
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 1).Value = Nom
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 2).Value = Prénom
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 3).Value = Adresse & " " & Adresse2
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 4).Value = Téléphone
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 5).Value = Mail
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 6).Value = DateInsc
                   Nom = ""
                   Prénom = ""
                   Adresse = ""
                   Adresse2 = ""
                   Téléphone = ""
                   Mail = ""
                   DateInsc = CDate("1/1/1900")
                Next i
            End If
        End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

T
Réponses
2
Affichages
7 K
T
C
Réponses
1
Affichages
684
M
Réponses
7
Affichages
2 K
matt60000
M
Retour