Regroupement de données

Le
celtic
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 su=
r
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
celtic
Le #18360381
On 10 jan, 16:25, celtic
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
michdenis
Le #18360691
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"
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
Publicité
Poster une réponse
Anonyme