Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Regroupement de données

Regroupement de données

2 réponses
Avatar
celtic
Bonjour =E0 tous et tout d'abord Bonne ann=E9e 2009.
Alors voil=E0, j'aimerais si possible avoir une astuce ou + concernant
un petit probl=E8me qui m'=E9viterait de faire du copier/coller !
Voil=E0 je re=E7ois des fichiers identique de plusieurs identit=E9, bien su=
r
il ne s'appelle pas tous pareille, et donc je s=E9lectionne les donn=E9es
remplies pr ces entit=E9s, via un filtrre sur une p=E9riode et je les
copies pour les ajouter =E0 mon fichier r=E9cap.
j'avais pens=E9 aux consolidation de donn=E9es mais cela ajoute !
Merci de votre aide, j'esp=E8re avoir =E9t=E9 clair
A+
Celtic
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
celtic
On 10 jan, 16:25, celtic wrote:
Bonjour à tous et tout d'abord Bonne année 2009.
Alors voilà, j'aimerais si possible avoir une astuce ou + concernant
un petit problème qui m'éviterait de faire du copier/coller !
Voilà je reçois des fichiers identique de plusieurs identité, bien sur
il ne s'appelle pas tous pareille, et donc je sélectionne les données
remplies pr ces entités, via un filtrre sur une période et je les
copies pour les ajouter à mon fichier récap.
j'avais pensé aux consolidation de données mais cela ajoute  !
Merci de votre aide, j'espère avoir été clair
A+
Celtic


Pour essayer d'être plus clair :
Je selectionne l'année garce à un filtre auto et je copie les lignes
concernées dans mon fichier récap, j'ai essayé une macro mais cela
n'a pas marché car il faut ouvrir les fichiers et ils n'ont
pratiquement jamais les mêmes noms !

Encore merci de votre aide
Avatar
michdenis
Voici une procédure que j'ai déjà publiée sur ce forum.

Si tous tes fichiers ont exactement la même structure
en ce qui concerne les données que tu veux extraire et
que si la feuille donnée de chaque fichier est dans la
première feuille de chaque classeur nonobstant son nom,
copie les 3 procédures suivantes dans un module standard
de ton fichier

Dans les macros suivantes : il est réputé que :
toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.

Au lieu d'appliquer un filtre sur tes feuilles, tu devras modifier
le texte de la requête pour n'avoir que les données concernées
La requête se retrouve dans la procédure
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
Il faudrait lui ajouter au moins une clause Where ....
Requete = "SELECT * From [" & NomFeuille & "]"

Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"

La procédure a exécuté est : Test

'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"

'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible d'indiquer la cellule
'à partir de laquelle seront copiés les résultats.

'----------1----------
'Même classeur que la procédure, dans la Feuil2
'Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")

'-----------2----------
'Autre classeur ouvert que celui de la procédure
Extraire_Data_First_Excel_Sheet "c:AAA", _
Workbooks("Classeur2").Worksheets("Feuil2").Range("G10")

''-----------3----------
'Dans la feuille active du classeur actif au
'moment de lancer la procédure
' Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")

End Sub
'------------------------------------------

Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)

'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"

'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String

'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")

ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Do While file <> ""
'Exclure le classeur où sont copiées les données
'pour ne pas dédoubler les data...

If Chemin & Rg.Parent.Parent.Name <> Chemin & file Then
'Identifier la cellule supérieur de gauche
'où seront copiées les données
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)

'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"

'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Ferme le recordset et la connection
Rst.Close: Conn.Close
'Passe au classeur suivant
file = Dir()
Else
'Passe au classeur suivant si le fichier
'où sont copiées les données est le même
'que celui qui est traité dans cette sub.
file = Dir()
End If
Loop
Application.EnableEvents = True
Application.Calculation = ModeCalcul
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
'"Microsoft Dao 3.6 Objects librairy"
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------



"celtic" a écrit dans le message de news:

Bonjour à tous et tout d'abord Bonne année 2009.
Alors voilà, j'aimerais si possible avoir une astuce ou + concernant
un petit problème qui m'éviterait de faire du copier/coller !
Voilà je reçois des fichiers identique de plusieurs identité, bien sur
il ne s'appelle pas tous pareille, et donc je sélectionne les données
remplies pr ces entités, via un filtrre sur une période et je les
copies pour les ajouter à mon fichier récap.
j'avais pensé aux consolidation de données mais cela ajoute !
Merci de votre aide, j'espère avoir été clair
A+
Celtic