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 :

Concaténation de feuille excel


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    Février 2011
    Messages
    71
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : Février 2011
    Messages : 71
    Par défaut Concaténation de feuille excel
    Bonjour,
    J'essaye de concaténer des feuilles excel dans un répertoire donné en une seul, les feuilles contiennent les même colonnes, j'ai fait une macro pour cela dont le code est le suivant

    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
    65
    66
    67
    68
    Sub RegrouperFeuille()
     
    Dim rep As String
        Dim wk As Workbook
        Dim XlApp As New Excel.Application
        Dim XlBook As Workbook
        Dim XlSheet As Worksheet
        Dim ExisteFichier As Boolean
        Dim nomFic As String
        'Variable pour permettre de gerer les entetes
        Dim i As Integer
        i = 1
     
        'On Error GoTo Erreur_Fichier:
        Set XlBook = XlApp.Workbooks.Add
        Set XlSheet = XlBook.Worksheets(1)
     
     
     
        ' test de l'existence du fichier prestataire
         nomFic = ThisWorkbook.path & "\FichierPrestataire.xls"
         ExisteFichier = (Dir(nomFic) <> "")
         If ExisteFichier = True Then
            Kill nomFic
         End If
     
         XlBook.SaveAs ThisWorkbook.path & "\FichierPrestataire"
     
     
        Dim l As Long
        'Initialisations
        l = 5
        rep = ThisWorkbook.path & "\Prestataires\"
        s = Dir(rep)
     
     
        Do
            Set wk = CreateObject(rep & s)
        wk.Activate
        If i = 1 Then
        Range("A3").Select
        Else
        Range("A7").Select
        End If
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
        XlBook.Activate
        If i = 1 Then
        l = XlSheet.Range("A65356").End(xlUp).Row
        Else
        l = XlSheet.Range("A65356").End(xlUp).Row + 1
        End If
        XlSheet.Range("A" & l).Select
        XlSheet.Paste
        wk.Activate
        Application.CutCopyMode = False
            wk.Close savechanges:=False
     
            s = Dir
            i = i + 1
        Loop While s <> ""
          XlBook.Save
        XlApp.Quit
    'Erreur_Fichier:
        'MsgBox "Le Dossier Prestataire ne contient aucun fichier"
     
     
    End Sub
    1 ) J'ai le bon résultat dans le fichier cible, le problème est que j'ai des cellules en couleurs qui apparaissent en fin du fichier créé et je ne vois pas trop d'ou sa viens si quelqu'un à une idée.

    2) Que dois-je faire pour que la largeur des cellules soit modifié automatiquement selon la taille du plus grand chiffre de la colonne dans le nouveau fichier créé?

  2. #2
    Membre éprouvé
    Homme Profil pro
    Consultant comptable
    Inscrit en
    Mai 2011
    Messages
    137
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Consultant comptable

    Informations forums :
    Inscription : Mai 2011
    Messages : 137
    Par défaut
    visiblement tu fais du copier coller, tes feuilles d'origines ne sont elles pas déja colorées ?

    pour ta deuxieme question juste en utilisant l'enregistreur de macro
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Columns("C:C").EntireColumn.AutoFit
    il y a, peu être, une meilleure méthode

  3. #3
    Membre confirmé
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    Février 2011
    Messages
    71
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : Février 2011
    Messages : 71
    Par défaut
    Pour Columns("C:C").EntireColumn.AutoFit si je l'intègre après de la ligne 52 dans le code fournis sa marche pas.
    Je ne vois pas ou la mettre autre part car quand je règle la taille des cellules manuellement c'est ici que je le fait.
    Pour mes feuilles d'origines l'entête est colorié (le nom des colonnes) mais pas de couleur autre part.

  4. #4
    Expert confirmé
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Par défaut
    Salut; XlSheet...... et à priori après la ligne 61

    Sinon la question de concaténation est récurrente voir http://www.google.fr/#sclient=psy&hl...w=1007&bih=725

  5. #5
    Membre confirmé
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    Février 2011
    Messages
    71
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : Février 2011
    Messages : 71
    Par défaut
    Pour la mise en forme des cellules sa marche effectivement, merci kiki et amnorian,
    Par contre kiki29 ma question n'est pas sur comment concaténer des feuilles xls vu que le code que j'ai fournit le fait bien mais plutôt sur les apparitions étrange de cellules en couleur à la fin du fichier créé.
    Désolé si je ne suis pas assez explicite.

  6. #6
    Membre confirmé
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    Février 2011
    Messages
    71
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : Février 2011
    Messages : 71
    Par défaut
    J'ai modifier un peu ma précédente macro pour gérer les apparition bizarre de cellule en couleur et la disparition de bordure de cellule et faire la mise en forme automatique des cellules dans le fichier résultat.

    Vu que je n'ai pas d'idée à l'avance d'ou vont apparaître ces fameuses cellules j'ai fait un traitement sur "A3:K1000" donc sa me prend pas mal de temps pour copier que quelque ligne au final ( environ 3 minutes).

    Donc si quelqu'un à une idée de comment accélérer les choses ou gérer le problème initial je suis preneur


    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
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    ' Consolider des données à partir de plusieurs feuilles
        Dim rep As String
        Dim wk As Workbook
        Dim ExisteFichier As Boolean
        Dim nomFic As String
        'Variable pour permettre de gerer les entetes
        Dim i As Integer
        i = 1
     
        'On Error GoTo Erreur_Fichier:
        Set XlBook = XlApp.Workbooks.Add
        Set XlSheet = XlBook.Worksheets(1)
     
     
     
        ' test de l'existence du fichier prestataire
         nomFic = ThisWorkbook.path & "\FichierPrestataireRes.xls"
         ExisteFichier = (Dir(nomFic) <> "")
         If ExisteFichier = True Then
            Kill nomFic
         End If
     
         XlBook.SaveAs ThisWorkbook.path & "\FichierPrestataireRes"
     
     
        Dim l As Long
        'Initialisations
        l = 3
        rep = ThisWorkbook.path & "\Prestataires\"
        s = Dir(rep)
     
     
        Do
            Set wk = CreateObject(rep & s)
        wk.Activate
     
        If i = 1 Then
        'recopier le masque du fichier
     
        Range("A5").Select
        Else
     
        'recopier les données à partir de la ligne 7 (modifier A7 par Ai si les données commencent à la ligne i)
        Range("A7").Select
        End If
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
        XlBook.Activate
     
        If i = 1 Then
        l = XlSheet.Range("A65356").End(xlUp).Row
        Else
        l = XlSheet.Range("A65356").End(xlUp).Row + 1
        End If
     
        'MsgBox " feuille active avant loop " & ActiveSheet.Name
        XlSheet.Range("A" & l).Select
     
        XlSheet.Paste
        wk.Activate
        Application.CutCopyMode = False
            wk.Close savechanges:=False
     
            s = Dir
            i = i + 1
        Loop While s <> ""
     
     
        'formatage de largeur de cellule pour affichage optimal
        XlSheet.Columns("A:K").EntireColumn.AutoFit
     
     
        ' gestion de l'apparition de couleur et de disparition de bordure de cellule
     
        Dim Cell As Range
        For Each Cell In XlSheet.Range("A3:K1000")
           Cell.Interior.Color = vbWhite
           Cell.Borders.Weight = 1
        Next Cell
     
        XlBook.Save
        XlApp.Quit
     
        Range("A1").Select
        Selection.Copy
        Range("A2").Select
        ActiveSheet.Paste

Discussions similaires

  1. Concaténation au sein d'une même feuille Excel
    Par stephaneparis dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 27/03/2009, 19h35
  2. Concaténer plusieurs feuilles excel Dans 1 seule
    Par joshua12 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 19/11/2008, 17h09
  3. [VBA-E]Type d'une feuille excel
    Par LitteulKevin dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 18/05/2004, 14h43
  4. [VB6]PB d'importation d'un feuille Excel dans une MSFlexGrid
    Par mystere l dans le forum VB 6 et antérieur
    Réponses: 18
    Dernier message: 20/04/2004, 15h59
  5. remplir feuille excel
    Par thibaud60 dans le forum Access
    Réponses: 2
    Dernier message: 24/11/2003, 10h21

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