Récupérer seulement les nouvelles données

[flosauveur69]

Bonjour,

Suite à la macro ci-dessous, je récupère dans un fichier mère des plages de cellules dans plusieurs fichiers fils qui sont dans des sous répertoire du même répertoire. Pour ce faire la macro ouvre chaque fichier fils, récupère la plage et ferme le fichier.
Le nombre de fichiers fils augmente de jour en jour. Donc à chaque fois que je lance la macro, elle me récupère les plages de cellule dans les fichiers où elles ont déjà été récupéré en plus de nouveaux fichiers.

Si c'est réalisable (et je pense) je voudrais donc qu'elle me récupère uniquement les plages de cellule dans les fichiers fils nouveaux. C'est à dire ceux où la plage de cellule n'a pas déjà été recopié et qu'elle me colle les nouveaux plages à la suite des anciennes.

Merci d'avance.

voici ma macro actuelle qui dès que je la lance me copie par dessus les anciennes plages, ces mêmes plages en plus des nouvelles

Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls"
If strFile <> strWB Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)

lgDerLig = lgDerLig + 15

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[mth]

Re : Récupérer seulement les nouvelles données

Bonjour,

Peut-être peux-tu inscrire le nom du fichier une fois traité quelque part dans une feuille, tu auras une liste qui se complètera au fil de l'eau.

Ensuite, tu ajoutes un test sur strFile, soit il existe dans la liste des fichiers déjà traités, et tu passes au suivant, soit il n'existe pas, et tu poursuis ton traitement.

Bien à toi,

mth

Edit: 🙂 Bonjour Job 🙂

 

[job75]

Re : Récupérer seulement les nouvelles données

Bonjour flosauveur69,

Il faut modifier la macro comme suit :

- indiquer le nom de chaque fichier copié à coté de la plage de restitution

- avant de faire la copie, rechercher (méthode Find) le nom du fichier et ne faire la copie que si ce nom n'existe pas.

Pas très compliqué, je vous laisse faire, mais revenez si vous n'y arrivez pas.

Edit : bonjour Mireille, heureux de te croiser de nouveau 🙂

A+

 

[flosauveur69]

Re : Récupérer seulement les nouvelles données

Merci de vos précisions, j'y ai réfléchi mais comme je suis un novice de macro excel, je ne vois pas comment faire.

Merci par avance

 

[job75]

Re : Récupérer seulement les nouvelles données

Re,

Les modifications sont en rouge :

Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" [COLOR="red"]et si son nom n'existe pas en colonne C[/COLOR]
If strFile <> strWB [COLOR="Red"]And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing [/COLOR]Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)
[COLOR="red"]Workbooks(strWB).Worksheets("Feuil1").Range("C" & lgDerLig) = strFile[/COLOR]
lgDerLig = lgDerLig + [COLOR="red"]16 'il me semble, puique la hauteur copiée est de 16...[/COLOR]

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

A+

 

[flosauveur69]

Re : Récupérer seulement les nouvelles données

Merci beaucoup, c'est exactement ce qu'il me fallait!

Autre chose: j'aimerais que le dossier où se trouvent les sous-répertoire et donc les classeurs ne soient pas :ThisWorkbook.Path
j'ai donc remplacé la ligne

strFile = Dir(ThisWorkbook.Path & "\*.xls")
(car strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls") ne marchait pas)

par

strFile = Dir("D:\Documents and Settings\fl\Bureau\excel" & "\SousRepertoire\*.xls")

cependant cela ne fonctionne pas, j'ai changé 2-3 trucs dans la macro mais rien n'as changé.

 

[job75]

Re : Récupérer seulement les nouvelles données

Re,

Tel qu'est le code, il y a un seul sous-répertoire étudié, nommé "SousRepertoire".

S'il y plusieurs sous-répertoires à étudier, c'est nettement plus compliqué.

Ouvrez alors un autre fil.

A+

 

[flosauveur69]

Re : Récupérer seulement les nouvelles données

Bonjour,

seul petit souci que je n'avais pas vu: cela marche dans le sens où la macro ne me rouvre pas les anciens fichiers mais elle me copie les données sur les anciennes alors que j'aimerais qu'elle me copie les données avant les anciennes.

Je vous met les fichiers si vous voulez bien le regarder, à noter qu'il y a une autre macro dans le classeur dans module1 mais je ne pense pas qu'elle change quoi que ce soit.

Merci beaucoup!

 

[flosauveur69]

Re : Récupérer seulement les nouvelles données

Oups j'avais oublié de mettre la PJ

 

[job75]

Re : Récupérer seulement les nouvelles données

Bonjour flosauveur69,

(...) j'aimerais qu'elle me copie les données avant les anciennes.

Exact, je n'y avais pas pensé...

Alors essayez cette macro modifiée (je ne l'ai pas testée) :

Private Sub cmdRecupere_Click()
Dim strWB As String, strFile As String

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

[COLOR="Red"]' Copie des données
Workbooks(strFile).Worksheets(1).Range("A13:C28").Copy
With Workbooks(strWB).Worksheets("Feuil1")
  .Range("A2").Insert xlDown 'insertion en ligne 2
  .Range("C2:C17").ClearContents 'on ne garde que les données A2:B17
  .Range("C2") = strFile
End With[/COLOR]

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub

A+

 

[flosauveur69]

Re : Récupérer seulement les nouvelles données

Merci pour cette macro, elle semble fonctionner mais en ligne au lieu d'en colonne et elle fait comme avant en colonne, c'est à dire qu'elle copie les nouvelles données sur les anciennes.

Ce qui fait qu'elle me copie les données en ligne et en colonne et que cela semble marcher qu'en ligne alors que je voudrais qu'en colonne.

Je vais essayer de modifier la macro mais je ne suis pas sur d'y arriver étant novice en VBA

 

[job75]

Re : Récupérer seulement les nouvelles données

Re,

J'avais oublié un xlDown après Insert, ce que j'ai corrigé sur mon post précédent.

A+

 

[flosauveur69]

Re : Récupérer seulement les nouvelles données

OK, parfait cela fonctionne, merci vraiment