Compiler en ne gardant qu'une entete

Bonjour à tous

J'ai une macro pour effacer le contenu d'une feuille puis lancer la compilation de x fichiers qui ont le même format (intitulé, nombre de colonnes) et les compiler dans l'onglet vidé.

La macro fonctionne bien par contre, elle compile tous les fichier les un en dessous des autres en remettant à chaque fois les entêtes.

Est-il possible de modifier ce code pour ne garder que l'entête du premier fichier ? ou à défaut d'exclure l'ensemble des entêtes ? Je sèche depuis plusieurs jours.

En vous remerciant pour votre aide

Sub SupCompil()

Cells.Select

Selection.Delete Shift:=xlUp

Range("A1").Select

Dim Temp As String

Dim Ligne As Long

Temp = Dir(ActiveWorkbook.Path & "\*.xls")

Application.DisplayAlerts = False

Do While Temp <> ""

If Temp <> "Compil.xls" Then

Workbooks.Open ActiveWorkbook.Path & "\" & Temp

Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy

Workbooks("Compil.xls").Sheets(1).Activate

Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1

Range("A" & CStr(Ligne)).Select

ActiveSheet.Paste

Workbooks(Temp).Close

End If

Temp = Dir

Loop

Range("A1").Select

Application.DisplayAlerts = True

End Sub

Bonne journée !

Brigitte

bonjour

télécharge

https://www.youtube.com/watch?v=gwW2CDdvUUs

Power Query est une fonction d'Excel intégrée dans les versions plus récentes, et gratuite pour le tien.

ensuite tu fais menu Power Query, obtenir ou acquérir, depuis un classeur (ou un répertoire)

"combiner et charger"

la magie opère

fini VBA, vive la simplicité !

Bonjour,

Merci pour votre réponse rapide !! J'ai regardé un peu le module suggéré, mais ça me semble compliqué en mise en oeuvre.

Le fichier compilé serait à utiliser par plusieurs personnes dans toute la france avec des versions windows différentes etc.

Je voudrais vraiment simplifier leur tâche en leur faisant juste parvenir un fichier type avec un modop où il n'ont q'une bouton à appuyer pour compiler et sortir des stats à analyser sur une semaine (NB: les stats sont sur des celulles colorées de telle ou telle couleur, la mise en forme dans la compilation est essentielle) . Du coup, je cherche plutôt une solution VBA à mon problème d'entête

En vous remerciant !

Brigitte

re

compiler pour faire des stats :

alors tu devrais regarder Power BI (il y a une version Desktop gratuite)

son job est de faire des stats, uniquement des stats. Et il les fait 1000 fois mieux qu'Excel. Depuis des mois, je ne fais plus aucune stat sous Excel pour mes petits patrons.

les consommateurs n'ont qu'à cliquer "actualiser"

jettes-y à oeil à l'occasion, il en vaut la peine.

concernant les Excel strictement <2010, en effet, pas de possibilité de Power Query

les couleurs ne posent jamais de problème.

note : pourquoi faire des stats "localement" ? ne peux-tu pas faire la préparation, y compris l'extraction et la mise en forme, et distribuer le résultat (soit des pdf, soit un xls(x) )

note 2 : les consommateurs de Power Query n'ont qu'à cliquer "actualiser". Ils ne font aucun effort

je passe la parole à des VBAistes plus qualifiés que moi

bon travail

Bonjour,

Merci quand même pour les suggestions

Je ne serais pas chargée des stats à fournir, j'ai fais l'ergonomie des graphs souhaités pour chacun mais ensuite, chaque opérateur ira prendre l'info qui le concerne dans sa propre extraction. Le fichier ne sera pas 100% identique et partagé par tous mais adaptés au besoin de chacun. Tout est prêt sauf ce petit soucis d'entête qui m'empêche de pouvoir filrer les résultats et faore des sommes prd correctement (car il y a des nombres et du texte dans une même colonne du coup).

Bonne soirée à toi,

Briegitte

re

solution possible qui fonctionnera dans 5 minutes et durant des années :

• admettant que tu as récupéré tes données en Feuil1, avec des lignes de texte en trop
• en feuil2, en A1 tu fais = SI( ESTTEXTE(et tu cliques en feuil1 A1); 0 ; tu cliques à nouveauen feuil1 A1)

• Etends cette formule pour couvrir toutes les données de feuil1 et plus car elles vont grandir au fil du temps
• base tes SOMMEPROD et autres sur feuil2 qui ne contient maintenant que des nombres

oooops ! ne pas le faire en ligne 1, mais à partir de ligne 2

ligne 1 de feuil2 contient les textes de ligne 1 de feuil1. Tu sauras faire

pas de VBA.

Bonjour,

jmd a écrit :

je passe la parole à des VBAistes plus qualifiés que moi

Pas certain que le code que tu utilises soit optimisé, mais sans changer tout (puisque ça fonctionne) j'essaierais l'adaptation suivante:

Sub SupCompil()
Dim Temp As String
Dim Ligne As Long
Dim flag As Byte 'sert de "témoin": vaut 0, au départ, et passe à 1 après la compil du premier fichier
With ThisWorkbook.Sheets(1)
    .Cells.Delete Shift:=xlUp
    .Range("A1").Select
    Temp = Dir(ActiveWorkbook.Path & "\*.xls")
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Do While Temp <> ""
        If Temp <> "Compil.xls" Then
            Workbooks.Open ActiveWorkbook.Path & "\" & Temp
            Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Offset(flag, 0).Copy
            .Activate
            Ligne = .Range("A65536").End(xlUp).Row + 1
            .Range("A" & CStr(Ligne)).Select
            ActiveSheet.Paste
            Workbooks(Temp).Close
        End If
        flag = 1
        Temp = Dir
    Loop
    .Range("A1").Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End With
End Sub

PS: SOMMEPROD peut parfois fonctionner sur des plages où du texte apparaît parmi des données numériques, si on utilise un ';' au lieu de '*'

Bonjour,

Essayer ce code (les "Select" sont inutiles)

Sub SupCompil()
    Dim Temp As String
    Dim cellule_destination As Range, A_copier As Range
    Dim premier_fichier As Boolean

    Application.DisplayAlerts = False
    Cells.Clear

    premier_fichier = True
    Set cellule_destination = ThisWorkbook.ActiveSheet.Range("A1")
    Temp = Dir(ThisWorkbook.Path & "\*.xls")
    Do While Temp <> ""
        If Temp <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\" & Temp
            Set A_copier = ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
            If Not premier_fichier Then
                Set cellule_destination = ThisWorkbook.ActiveSheet.Columns("A").Find("")
                Set A_copier = A_copier.Offset(1).Resize(A_copier.Rows.Count - 1)
            Else
                premier_fichier = False
            End If
            A_copier.Copy cellule_destination
            ActiveWorkbook.Close
        End If
        Temp = Dir
    Loop

    Range("A1").Select
    Application.DisplayAlerts = True
End Sub