Microsoft 365 VBA excel cumuler des données alphanumériques

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion phil75016
  • 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 !

S'inscrire
P

phil75016

XLDnaute Junior
Bonjour, je souhaiterais obtenir dans une variable le cumul de plusieurs variables aphanumériques. Je m'explique, je voudrais que la macro enregistre dans une variable les données d'une variable d'un premier fichier puis la variable d'autant de fichiers qui ont été ouvert. Par exemple dans le premier fichier ouvert, j'enregistre la variable dans la cellule A1 qui serait "MAMAN", puis j'ouvre un 2ème fichier et la cellule A1 serait "PAPA" et ainsi de suite sur autant de fichiers qui auraient été ouvert. Au final je voudrais obtenir dans une seule variable MAMAN, PAPA, ETC...
Je vous remercie
 
Dernière édition:
Trier par date Trier par votes
Bonjour,

Ajoute une feuille à ton classeur et renomme-la "resultat" pour avoir l'aperçu des valeurs récupérées.
Adapte si besoin le chemin où se trouvent les fichiers. mettre le code dans un module standard.

nb: ne récupère que les valeurs des fichiers xlsx
VB: 
Option Explicit

Sub Recueillir_Valeurs()
    Dim Chemin As String, i As Long, Fichier As String
    Dim valeur As Variant, TbV() As Variant, Compteur As Long

    ' Chemin du dossier contenant les fichiers
      Chemin = ThisWorkbook.Path & "\"
 
    Compteur = 0

    Fichier = Dir(Chemin & "*.xlsx") ' Modifiez l'extension si nécessaire

    ' Boucle à travers les fichiers dans le dossier
    Do While Fichier <> ""
        ' Utilisation de GetObject pour accéder au fichier
        On Error Resume Next
        valeur = GetObject(Chemin & Fichier).Worksheets(1).Range("A1").Value
        On Error GoTo 0
        
        ' Si la valeur a été récupérée avec succès, l'ajouter au tableau
        If Not IsEmpty(valeur) Then
            Compteur = Compteur + 1
            ReDim Preserve TbV(1 To Compteur) ' Redimensionner le tableau
            TbV(Compteur) = valeur
        End If
        
        ' Passer au fichier suivant
        Fichier = Dir
    Loop

    ' Écrire toutes les valeurs recueillies sur la feuille "resultat"
    Sheets("resultat").Cells.Clear
    For i = 1 To UBound(TbV)
        Sheets("resultat").Cells(i, 1).Value = TbV(i)
    Next i

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
 
Vote positif 0 Vote négatif
dysorthographie à dit:
Bonjour,
Maman, Papa,etc
Etc correspond au frère et soeur, chat , chien, poisson rouge ?

Explicite ta pensée.
Cliquez pour agrandir...
C'était juste un exemple car dans mon fichier ce sont des codes sociétés (ex T102, A003...) que je dois récupérer dans les différents fichiers que je vais ouvrir par Application.GetOpenFileName pour au final créer un fichier dont le nom sera par exemple T102-A003-etc.XLSM
 
Vote positif 0 Vote négatif
phil75016 à dit:
C'était juste un exemple car dans mon fichier ce sont des codes sociétés (ex T102, A003...) que je dois récupérer dans les différents fichiers que je vais ouvrir par Application.GetOpenFileName pour au final créer un fichier dont le nom sera par exemple T102-A003-etc.XLSM
Cliquez pour agrandir...
Ta question n'était donc pas complète. Le code proposé n'ouvre pas les fichiers, il scrute tous les fichiers Xlsx se trouvant dans le même dossier que le fichier xlsm. Maintenant si j'ai bien compris, tu fais une multiselection de fichiers à ouvrir?
 
Dernière édition:
Vote positif 0 Vote négatif
à tester
VB: 
Sub ChoixFichiersRecueillirValeurs()
    Dim Chemin As Variant, valeur As Variant, Tbv() As Variant
    Dim count As Long, i As Long, fichier As Variant

    Chemin = Application.GetOpenFilename( _
        FileFilter:="Fichiers Excel (*.xlsm; *.xlsb; *.xls; *.xlsx), *.xlsm; *.xlsb; *.xls; *.xlsx", _
        MultiSelect:=True)

    If TypeName(Chemin) = "Boolean" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If

    count = 0

    For Each fichier In Chemin
        On Error Resume Next
        valeur = GetObject(fichier).Worksheets(1).Range("A1").Value
        On Error GoTo 0
        
        If Not IsEmpty(valeur) Then
            count = count + 1
            ReDim Preserve Tbv(1 To count)
            Tbv(count) = valeur
        End If
    Next fichier

    For i = 1 To UBound(Tbv)
        Debug.Print Tbv(i) ' Affiche les valeurs dans la fenêtre d'exécution
    Next i

    Sheets("resultat").Cells.Clear
    For i = 1 To UBound(Tbv)
        Sheets("resultat").Cells(i, 1).Value = Tbv(i)
    Next i

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
 
Vote positif 0 Vote négatif
cathodique à dit:
à tester
VB: 
Sub ChoixFichiersRecueillirValeurs()
    Dim Chemin As Variant, valeur As Variant, Tbv() As Variant
    Dim count As Long, i As Long, fichier As Variant

    Chemin = Application.GetOpenFilename( _
        FileFilter:="Fichiers Excel (*.xlsm; *.xlsb; *.xls; *.xlsx), *.xlsm; *.xlsb; *.xls; *.xlsx", _
        MultiSelect:=True)

    If TypeName(Chemin) = "Boolean" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If

    count = 0

    For Each fichier In Chemin
        On Error Resume Next
        valeur = GetObject(fichier).Worksheets(1).Range("A1").Value
        On Error GoTo 0
      
        If Not IsEmpty(valeur) Then
            count = count + 1
            ReDim Preserve Tbv(1 To count)
            Tbv(count) = valeur
        End If
    Next fichier

    For i = 1 To UBound(Tbv)
        Debug.Print Tbv(i) ' Affiche les valeurs dans la fenêtre d'exécution
    Next i

    Sheets("resultat").Cells.Clear
    For i = 1 To UBound(Tbv)
        Sheets("resultat").Cells(i, 1).Value = Tbv(i)
    Next i

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
Cliquez pour agrandir...
Merci Cath, c'est vrai que je n'arrive pas bien à formuler ce que je souhaite obtenir. Ta macro fonctionne bien mais je vais décrire exhaustivement mon besoin :
- J'ouvre le fichier ZZZ.xlsm qui contient la macro
- Avec Application.GetOpenFileName j’ouvre un premier fichier AAA.xlsm, je récupère un code qui est dans la cellule A1, un nom dans la cellule A2 et je copie ces 2 données dans le fichier ZZZ.xlsm et je ferme le fichier AAA.xlsm
- Je demande s’il y a un autre fichier à ouvrir
- Si oui, j’ouvre le fichier BBB.xlsm, je récupère le code qui est dans la cellule A1, le nom dans la cellule A2 et je copie ces 2 données dans le fichier ZZZ.xlsm sous les données du fichier AAA et je ferme le fichier BBB.xlsm
- Je demande s’il y a un autre fichier à ouvrir et je boucle sur tous les fichiers que je veux ouvrir
- Au final le fichier ZZZ.xlsm je le renomme de cette façon : Ce fichier contient les sociétés AAA-BBB-etc.xlsm

J'espère être assez clair!!!
 
Dernière édition:
Vote positif 0 Vote négatif
phil75016 à dit:
J'espère être assez clair!!!
Cliquez pour agrandir...
ça beaucoup embrouillé!

un essai, choisir tous les fichiers à traiter (ils doivent être dans le même dossier)
VB: 
Sub NouveauFichier()
    Dim Chemin As Variant, valA1 As Variant, valB1 As Variant
    Dim Tbv() As Variant
    Dim count As Long, i As Long, fichier As Variant
    Dim nomFichiers As String

    Chemin = Application.GetOpenFilename( _
        FileFilter:="Fichiers Excel (*.xlsm; *.xlsb; *.xls; *.xlsx), *.xlsm; *.xlsb; *.xls; *.xlsx", _
        MultiSelect:=True)

    If TypeName(Chemin) = "Boolean" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If

    count = 0
    nomFichiers = ""

    For Each fichier In Chemin
        On Error Resume Next
        valA1 = GetObject(fichier).Worksheets(1).Range("A1").Value
        valB1 = GetObject(fichier).Worksheets(1).Range("B1").Value
        On Error GoTo 0
        
        If Not IsEmpty(valA1) Then
            count = count + 1
            
            ReDim Preserve Tbv(1 To 2, 1 To count)
            
            Tbv(1, count) = valA1
            Tbv(2, count) = valB1
            
            nomFichiers = nomFichiers & Split(Dir(fichier), ".")(0) & "-"
        End If
    Next fichier

    
    If Right(nomFichiers, 1) = "-" Then
        nomFichiers = Left(nomFichiers, Len(nomFichiers) - 1) ' Supprimer le dernier tiret
    End If

    Sheets("resultat").Cells.Clear
    For i = 1 To count
        Sheets("resultat").Cells(i, 1).Value = Tbv(1, i)
        Sheets("resultat").Cells(i, 2).Value = Tbv(2, i)
    Next i
Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nomFichiers & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
 
Vote positif 0 Vote négatif
cathodique à dit:
ça beaucoup embrouillé!

un essai, choisir tous les fichiers à traiter (ils doivent être dans le même dossier)
VB: 
Sub NouveauFichier()
    Dim Chemin As Variant, valA1 As Variant, valB1 As Variant
    Dim Tbv() As Variant
    Dim count As Long, i As Long, fichier As Variant
    Dim nomFichiers As String

    Chemin = Application.GetOpenFilename( _
        FileFilter:="Fichiers Excel (*.xlsm; *.xlsb; *.xls; *.xlsx), *.xlsm; *.xlsb; *.xls; *.xlsx", _
        MultiSelect:=True)

    If TypeName(Chemin) = "Boolean" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If

    count = 0
    nomFichiers = ""

    For Each fichier In Chemin
        On Error Resume Next
        valA1 = GetObject(fichier).Worksheets(1).Range("A1").Value
        valB1 = GetObject(fichier).Worksheets(1).Range("B1").Value
        On Error GoTo 0
       
        If Not IsEmpty(valA1) Then
            count = count + 1
           
            ReDim Preserve Tbv(1 To 2, 1 To count)
           
            Tbv(1, count) = valA1
            Tbv(2, count) = valB1
           
            nomFichiers = nomFichiers & Split(Dir(fichier), ".")(0) & "-"
        End If
    Next fichier

   
    If Right(nomFichiers, 1) = "-" Then
        nomFichiers = Left(nomFichiers, Len(nomFichiers) - 1) ' Supprimer le dernier tiret
    End If

    Sheets("resultat").Cells.Clear
    For i = 1 To count
        Sheets("resultat").Cells(i, 1).Value = Tbv(1, i)
        Sheets("resultat").Cells(i, 2).Value = Tbv(2, i)
    Next i
Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nomFichiers & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
Cliquez pour agrandir...
J'admets que c'était un peu brouillon!! Mais merci quand même, je vais essayer de faire quelque chose avec ta proposition.
 
Vote positif 0 Vote négatif
phil75016 à dit:
J'admets que c'était un peu brouillon!! Mais merci quand même, je vais essayer de faire quelque chose avec ta proposition.
Cliquez pour agrandir...
un dernier essai, si j'ai bien compris.
VB: 
Sub NouveauFichier()
    Dim Chemin As Variant, valA1 As Variant, valB1 As Variant 
    Dim Tbv() As Variant 
    Dim count As Long, i As Long, fichier As Variant 
    Dim nomFichiers As String 
    Dim continuer As Boolean
    
    count = 0 
    nomFichiers = ""
    continuer = True

    Do While continuer 
        Chemin = Application.GetOpenFilename( _
            FileFilter:="Fichiers Excel (*.xlsm; *.xlsb; *.xls; *.xls; *.xlsx), *.xlsm; *.xlsb; *.xls; *.xlsx")
        
        If TypeName(Chemin) = "Boolean" Then 
            MsgBox "Aucun fichier sélectionné.", vbExclamation 
            continuer = False ' Sortir de la boucle si aucun fichier n'est sélectionné 
        Else 
            On Error Resume Next 
            valA1 = GetObject(Chemin).Worksheets(1).Range("A1").Value 
            valB1 = GetObject(Chemin).Worksheets(1).Range("B1").Value 
            On Error GoTo 0
            
            If Not IsEmpty(valA1) Then 
                count = count + 1
                
                ReDim Preserve Tbv(1 To 2, 1 To count)
                
                Tbv(1, count) = valA1 
                Tbv(2, count) = valB1
                
                nomFichiers = nomFichiers & Split(Dir(Chemin), ".")(0) & "-"
            End If 
        End If 
    Loop
    
    If Right(nomFichiers, 1) = "-" Then 
        nomFichiers = Left(nomFichiers, Len(nomFichiers) - 1) ' Supprimer le dernier tiret 
    End If

    Sheets("resultat").Cells.Clear 
    For i = 1 To count 
        Sheets("resultat").Cells(i, 1).Value = Tbv(1, i)
        Sheets("resultat").Cells(i, 2).Value = Tbv(2, i)
    Next i

    Application.DisplayAlerts = False 
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nomFichiers & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled 
    Application.DisplayAlerts = True

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
 
Vote positif 0 Vote négatif
cathodique à dit:
un dernier essai, si j'ai bien compris.
VB: 
Sub NouveauFichier()
    Dim Chemin As Variant, valA1 As Variant, valB1 As Variant
    Dim Tbv() As Variant
    Dim count As Long, i As Long, fichier As Variant
    Dim nomFichiers As String
    Dim continuer As Boolean
   
    count = 0
    nomFichiers = ""
    continuer = True

    Do While continuer
        Chemin = Application.GetOpenFilename( _
            FileFilter:="Fichiers Excel (*.xlsm; *.xlsb; *.xls; *.xls; *.xlsx), *.xlsm; *.xlsb; *.xls; *.xlsx")
       
        If TypeName(Chemin) = "Boolean" Then
            MsgBox "Aucun fichier sélectionné.", vbExclamation
            continuer = False ' Sortir de la boucle si aucun fichier n'est sélectionné
        Else
            On Error Resume Next
            valA1 = GetObject(Chemin).Worksheets(1).Range("A1").Value
            valB1 = GetObject(Chemin).Worksheets(1).Range("B1").Value
            On Error GoTo 0
           
            If Not IsEmpty(valA1) Then
                count = count + 1
               
                ReDim Preserve Tbv(1 To 2, 1 To count)
               
                Tbv(1, count) = valA1
                Tbv(2, count) = valB1
               
                nomFichiers = nomFichiers & Split(Dir(Chemin), ".")(0) & "-"
            End If
        End If
    Loop
   
    If Right(nomFichiers, 1) = "-" Then
        nomFichiers = Left(nomFichiers, Len(nomFichiers) - 1) ' Supprimer le dernier tiret
    End If

    Sheets("resultat").Cells.Clear
    For i = 1 To count
        Sheets("resultat").Cells(i, 1).Value = Tbv(1, i)
        Sheets("resultat").Cells(i, 2).Value = Tbv(2, i)
    Next i

    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nomFichiers & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True

    MsgBox "Les valeurs ont été recueillies avec succès !"
End Sub
Cliquez pour agrandir...
Merci beaucoup, à la base je pensais que cela aurait été plus simple et qu'il n'y aurait pas besoin de passer par une autre feuille "resultat" mais qu'il y aurait une possibilité de stocker les différentes données dans une valeur tampon qui accumulerait les données et au final cette valeur tampon servirait pour donner le nom au fichier mais je vais me servir de ta macro et l'adapter à ma situation.
 
Vote positif 0 Vote négatif
Bonjour,

phil75016 à dit:
je vais décrire exhaustivement mon besoin :
- J'ouvre le fichier ZZZ.xlsm qui contient la macro
- Avec Application.GetOpenFileName j’ouvre un premier fichier AAA.xlsm, je récupère un code qui est dans la cellule A1, un nom dans la cellule A2 et je copie ces 2 données dans le fichier ZZZ.xlsm et je ferme le fichier AAA.xlsm
- Je demande s’il y a un autre fichier à ouvrir
- Si oui, j’ouvre le fichier BBB.xlsm, je récupère le code qui est dans la cellule A1, le nom dans la cellule A2 et je copie ces 2 données dans le fichier ZZZ.xlsm sous les données du fichier AAA et je ferme le fichier BBB.xlsm
- Je demande s’il y a un autre fichier à ouvrir et je boucle sur tous les fichiers que je veux ouvrir
- Au final le fichier ZZZ.xlsm je le renomme de cette façon : Ce fichier contient les sociétés AAA-BBB-etc.xlsm
Cliquez pour agrandir...
Tout ça on l'avait bien compris dès #1.

En revanche, en #1 tu parles d'avoir une variable dans laquelle tu ajoutes les textes les uns après les autres, mais en #8 tu parles de noter les textes dans le classeur initial.
Du coup tu veux quoi en réalité ?
 
Vote positif 0 Vote négatif
TooFatBoy à dit:
Bonjour,


Tout ça on l'avait bien compris dès #1.

En revanche, en #1 tu parles d'avoir une variable dans laquelle tu ajoutes les textes les uns après les autres, mais en #8 tu parles de noter les textes dans le classeur initial.
Du coup tu veux quoi en réalité ?
Cliquez pour agrandir...
salut @TooFatBoy ,

@TooFatBoy : non, en #8 il n'y avait pas seulement ce que tu dis. Il a demandé de récupérer aussi le nom des fichiers concernés pour enregistrer sous un nouveau nom le fichier (nom= concaténation des fichiers).
 
Vote positif 0 Vote négatif
phil75016 à dit:
Merci beaucoup, à la base je pensais que cela aurait été plus simple et qu'il n'y aurait pas besoin de passer par une autre feuille "resultat" mais qu'il y aurait une possibilité de stocker les différentes données dans une valeur tampon qui accumulerait les données et au final cette valeur tampon servirait pour donner le nom au fichier mais je vais me servir de ta macro et l'adapter à ma situation.
Cliquez pour agrandir...
la feuille resultat n'est là que pour vérification du rendu.

tu as demandé une variable, suite à ton post#8.

Tu as 2 variables Tbv est une variable tableau (array) pour les données se trouvant en cellules A1 et B1.

la seconde variable est nomFichiers.

Si tu ne veux pas utiliser la feuille "resultat", tu peux passer outre.

Cependant, n'oublie pas de déclarer ces variables en global ou public.

Apparemment, tu ne sais pas exactement ce que tu veux. De plus tu n'as même pas joint de fichiers.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

O
  • Résolu(e)
XL 2013 VBA/ Macro qui classe des données dans une colonne unique
Réponses
5
Affichages
91
onyirimba
O
C
  • Question Question
Microsoft 365 Disparation de données dans des fichiers excel
Réponses
10
Affichages
314
CedricR34
C
frederio
  • Question Question
XL 2019 automatiquement les données de internet - EXCEL VBA
Réponses
3
Affichages
198
frederio
frederio
Robyalex
  • Résolu(e)
XL 2021 tableau de données
Réponses
9
Affichages
200
AtTheOne
AtTheOne
A
  • Question Question
XL 2021 extraire des informations de plusieurs fichiers
Réponses
4
Affichages
198
job75
job75
Y
  • Résolu(e)
XL 2016 Importer des données suivant l'ordre de passage
Réponses
10
Affichages
259
YGU1
Y
H
  • Question Question
Power Query Récupérer des données multiples dans un dossier
Réponses
9
Affichages
191
hijackfr
H
P
  • Question Question
XL 2016 VBA Appliquer un filtre sur mes données importées
Réponses
4
Affichages
164
sousou
sousou
ralph45
  • Résolu(e)
Microsoft 365 [VBA] Listes dynamiques selon cases à (dé)cocher
2
Réponses
18
Affichages
458
alexga78
A
B
  • Question Question
XL 2021 VBA pour générer une liste de valeurs comprise entre 2 valeurs
2
Réponses
16
Affichages
279
benjy555
B
R
  • Résolu(e)
XL 2010 vba excel : recherche concordance chaine texte dans cellule et données stockées dans un tablo (array)
Réponses
4
Affichages
70
Raynaud.JF
R
fenec
  • Résolu(e)
Autres Copier/ Coller plage de données dans une autre cellule d'un même onglet
Réponses
6
Affichages
103
fenec
fenec
B
  • Question Question
XL 2016 Somme automatique des prix associés aux produits sélectionnés sur Excel
Réponses
6
Affichages
106
bkarima1
B
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
149
fanch55
fanch55
A
  • Résolu(e)
Microsoft 365 cumuler des valeurs de cellules dont l'emplacement peut varier dans des tableaux
Réponses
4
Affichages
552
auloin
A
R
  • Question Question
XL 2010 Copier des lignes de données de plusieurs feuilles dans une seule
Réponses
6
Affichages
619
AtTheOne
AtTheOne
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
223
xavieralvaro
X
M
  • Question Question
XL 2019 La méthode select de la classe range a échoué
Réponses
4
Affichages
109
job75
job75
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
129
CDALE
C
A
  • Question Question
Microsoft 365 Affichage , recherche et extraire des données .
Réponses
1
Affichages
89
vgendron
vgendron
Retour