IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

VBA/ ajouter nom du fichier source copié dans une colonne


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Nouveau candidat au Club
    Femme Profil pro
    Conseil - Consultant en systèmes d'information
    Inscrit en
    Mai 2017
    Messages
    1
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Haute Garonne (Midi Pyrénées)

    Informations professionnelles :
    Activité : Conseil - Consultant en systèmes d'information

    Informations forums :
    Inscription : Mai 2017
    Messages : 1
    Par défaut VBA/ ajouter nom du fichier source copié dans une colonne
    Bonjour à tous et merci par avance de votre aide.

    J’essaie de regrouper des fichiers dans un nouveau classeur : Resultats.csv.
    Tout est ok sauf que je n’arrive pas à mettre dans la colonne 10 (sur chaque ligne copiée) du nouveau classeur le nom du fichier source que j’ai par ailleurs dans ma variable fic ou elo.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    Sub concaténer()     ' regroupement des commentaires
    Const fdr = "Resultats.csv"  ' fichier du résultat
    Dim chemin As String    ' classeur regroupé
    Dim rep As String       ' répertoire à traiter
    Dim fic As String       ' classeur regroupé
    Dim nbl As Long         ' lignes écriture
    Dim nbc As Integer      ' nombre de classeurs
    Dim lig As Long         ' ligne lecture
    Dim Wl As Worksheet     ' feuille regroupée
    Dim tbc()               ' tableau montants
    Dim tbl()               ' tableau lu
    Dim pos As Integer      ' position $ somme
    Dim poz As Integer      ' position " " somme
    Dim elo As String
     
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            .Title = "Choisissez votre répertoire"
            .Filters.Clear
            .Show
            If .SelectedItems.Count = 0 Then Exit Sub
            rep = .SelectedItems(1) & "\"
        End With
        Open rep & fdr For Output As #1
        fic = Dir(rep & "*.xls*")
        tbc = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
        lig = 2
        While fic <> ""
            chemin = rep & fic ' chemin fichiers
            elo = fic
                Workbooks.Open chemin  ' ouverture
                On Error Resume Next
                Set Wl = ActiveWorkbook.Sheets(1)
                If Err.Number = 0 Then      ' le classeur est sélectionné
                    tbl = Wl.UsedRange.Cells
                    While lig <= UBound(tbl) ' copier les 9 colonnes
                        Print #1, tbl(lig, 1) & ";" _
                                & tbl(lig, 2) & ";" _
                                & tbl(lig, 3) & ";" _
                                & tbl(lig, 4) & ";" _
                                & tbl(lig, 5) & ";" _
                                & tbl(lig, 6) & ";" _
                                & tbl(lig, 7) & ";" _
                                & tbl(lig, 8) & ";" _
                                & tbl(lig, 9)
                        lig = lig + 1
                        nbl = nbl + 1
                    Wend
                    nbc = nbc + 1
                Else
                    Err.Clear
                End If
                ActiveWorkbook.Close SaveChanges:=False   ' Fermeture du classeur
            fic = Dir
            lig = 3
        Wend
        Set Wl = Nothing
        Close #1
        MsgBox nbc & " Classeurs lus" & vbLf & nbl & " lignes écrites dans " & rep & fdr
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End Sub

  2. #2
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 419
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 419
    Par défaut
    Bonjour,
    Ne suffirait-il pas d'indiquer ceci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    ...
                                & tbl(lig, 8) & ";" _
                                & tbl(lig, 9) & ";" _
                                & fic
    ...
    (la variable elo ne me semble pas indispensable)

    Bonne continuation.

Discussions similaires

  1. Réponses: 0
    Dernier message: 05/08/2016, 15h06
  2. Afficher le nom du fichier en hyperlinks dans une cellule
    Par kaglaborn dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 13/10/2015, 15h34
  3. Nom de fichier image incrémenté dans une boucle for
    Par franck31 dans le forum Général JavaScript
    Réponses: 6
    Dernier message: 12/10/2011, 16h49
  4. Récupérer le nom du fichier en cours dans une variable.
    Par quiky dans le forum Balisage (X)HTML et validation W3C
    Réponses: 4
    Dernier message: 06/05/2009, 13h28
  5. Réponses: 20
    Dernier message: 22/03/2005, 21h07

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo