recuperer données d'un classeur fermé

[youklebambou]

Bonjour à tous,
après avoir posé la question et cherché sur plusieurs forums je ne trouve pas de réponses satisfaisante à ma question...j’espère que quelqu'un pourra m'aider...
J'explique je suis sur un "classeur 1" et je cherche à recuperer des données d'un "classeur 2" mais fermé!
Connaissais vous une solution????

 

[youklebambou]

alors en fait le problème est plus complexe ^^
j'ai fait maintes et maintes recherches et j'ai une premières solution mais c'est compliqué
en gros le moyen serait de créer une liaison (onglet "données connexions existante etc etc)
par contre faudrait que je crée un code vba pour çà
je m'explique : j'ai un classeur de récupération de donnée que j'appelle "classeur 1"
j'ai également plein de classeur nommée par exemple C1, C2, C3 etc etc
j'aimerais qu'en notant en A1 dans "classeur 1" puis en lançant une vba il me fasse une liaison vers le classeur stipulé en A1
exemple je note en A1 : C5 - > la vba me crée une liaison direct avec le classeur C5....
j'espère que c'est assez clair pour vous...mais ça me permettrai de résoudre un casse tète de plusieurs mois.... cordialement

 

[job75]

Bonjour youklebambou, le forum,

Ce problème est très classique et il y a de très nombreux exemples sur le forum !!!

On peut utiliser la méthode ADO ou comme avec cette solution des formules de liaison :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Dim nomfichier$, nomfeuille$, plage As Range, chemin$, f$
nomfichier = [A1] & ".xlsx" 'nom du fichier source, extension à adapter
nomfeuille = "Base" 'le même pour tous les fichiers à copier
Set plage = [A1:J200] 'plage maximum à copier
chemin = ThisWorkbook.Path 'à adapter si nécessaire
f = "'" & chemin & "\[" & nomfichier & "]" & nomfeuille & "'!"
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier n'est pas trouvé
With plage.Offset(2) 'copie décalée de 2 lignes
  .ClearContents 'RAZ
  If Not IsError(ExecuteExcel4Macro(f & "R1C1")) Then 'test de sécurité
    .FormulaR1C1 = "=IF(" & f & "R[-2]C=0,""""," & f & "R[-2]C)" 'formule de liaison
    .Value = .Value 'supprime les formules
    .Columns.AutoFit 'ajustement largeur
  End If
End With
End Sub

Téléchargez les fichiers joints dans le même répertoire (le bureau).

Edit : j'ai testé sur la plage A1:J20000, avec Win 10 - Excel 2013 la macro s'exécute en 1,72 seconde.

Bonne journée.

 

[job75]

Re,

Avec une formule matricielle c'est plus rapide :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Dim nomfichier$, nomfeuille$, plage As Range, chemin$, f$
nomfichier = [A1] & ".xlsx" 'nom du fichier source, extension à adapter
nomfeuille = "Base" 'le même pour tous les fichiers à copier
Set plage = [A1:J200] 'plage maximum à copier
chemin = ThisWorkbook.Path 'à adapter si nécessaire
f = "'" & chemin & "\[" & nomfichier & "]" & nomfeuille & "'!"
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier n'est pas trouvé
With plage.Offset(2) 'copie décalée de 2 lignes
  .ClearContents 'RAZ
  If Not IsError(ExecuteExcel4Macro(f & "R1C1")) Then 'test de sécurité
    .FormulaArray = "=IF(" & f & plage.Address & "=0,""""," & f & plage.Address & ")" 'formule matricielle
    .Value = .Value 'supprime la formule
    .Columns.AutoFit 'ajustement largeur
  End If
End With
End Sub

Fichier (2).

Sur A1:J20000, la macro s'exécute en 0,75 seconde.

A+

 

[youklebambou]

merci pour ces réponses rapides et pro !!!! je test ça en l'adaptant à mon exemple et je reviens vous dire si tout fonctionne ;-)

 

[youklebambou]

alors....plusieurs questions (désolé)
1 ) je ne maîtrise pas tout excel et parfois certaine fonction basique m'échappe. ici tu as fait ça sous forme de liste déroulante (d'ailleurs je ne sais pas comment tu as fait ^^). Le problème est que dans mon cas en fait les fichiers à copier (C1,C2,C3 etc) sont nombreux....1 par jour et sous ce format "20170523" (pour le 23 mai par exemple) donc je me vois pas créer une liste avec tout les jours...
2) je dois faire un truc simple donc par exemple adapter ce que tu as fait a un bouton. en gros les gens mettent la date et clique sur un bouton pour rapatrier les données.
3) dans ton exemple tu parles du chemin (thisworbook path) j'ai jamais utilisé ce genre de formule donc j'aimerais savoir par exemple si j'ai mon fichier destination dans un dossier A sur mon bureau et les fichier a copier dans un dossier B sur mon bureau, comment je note ca???
merci encore pour ta patience.... je sens que je suis pas loin d'avoir une solution ça me fait plaisir ^^

 

[youklebambou]

ok alors pour la liste déroulante j'ai trouvé ma réponse avec la validation des données

 

[job75]

Re,

Pour la question 2) la macro fonctionnera très bien si l'on entre la date manuellement en A1.

Pour la question 3) adaptez le chemin avec ce code :

chemin = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & "B"

Remplacez bien sûr B par le nom réel du dossier.

A+

 

[youklebambou]

ha oui !!!! en effet la macro fonctionne très bien en tapant juste la date ;-)
j'abuse de ta gentillesse.... mais....^^ :
1) j'ai essayer d'adapter ta macro a mon travail j'ai un autre souci, elle fonctionne très bien si l'extension de mon fichier a copier est ".xlsx" par contre mes fichiers sont en ".csv" et même en changeant l'extension dans le code vba ca ne fonctionne pas
2) je ne comprend pas comment tu as fais pour que ta macro sois actif sr le classeur directement...si je modifie les données dans ton classeur ça fonctionne très bien mais si je recopie ta macro dans un autre classeur c'est mort...

 

[job75]

Re,

1) Avec un fichier csv la méthode des formules de liaison ne peut pas fonctionner car il n'y a pas de cellules dans ces fichiers.

Il faut alors faire ouvrir les fichiers csv par Excel, cherchez sur le forum.

2) bien sûr c'est mort si vous ne collez pas la macro dans le code de la feuille.

A+

 

[youklebambou]

bon j'ai chercher mais je trouve pas de solution....
pour l'instant j'ai mis tout ton code et ça fonctionne très bien sous xlsx mais pas sous csv comme tu me l'a fait remarqué donc je me suis demandé si y'avait pas un moyen pour inclure dans cette macro une autre fonction.... je m'explique :
la macro ouvre le fichier de données, l'enregistre sous .xlsx (avec le même nom) , referme le fichier csv et le supprime; puis ca reprend la macro qui copie mes données...
j'ai tenté en utilisant l'enregistrement de macro mais ca m'enregistre le fichier avec la macro pas l'autre...
bref si quelqu'un a une solution....encore merci

 

[job75]

Bonsoir youklebambou,

Pour copier les fichiers csv je vous ai dit de chercher sur le forum, poil dans la main ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Dim dossier$, chemin$, nomfichier$
dossier = "B" 'nom du dossier cousin, à adapter
chemin = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & dossier
nomfichier = [A1] & ".csv" 'nom du fichier csv à copier
Application.ScreenUpdating = False
On Error Resume Next 'si le fichier n'existe pas
Rows("3:" & Rows.Count).ClearContents 'RAZ
With Workbooks.Open(chemin & "\" & nomfichier).Sheets(1)
  .UsedRange.TextToColumns .UsedRange.Cells(1), xlDelimited, Semicolon:=True 'commande Convertir
  [A3].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count) = .UsedRange.Value
  [A3].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).Columns.AutoFit 'ajustement largeur
  .Parent.Close False
End With
End Sub

Les fichiers sont dans les dossiers A et B zippés joints.

A+

 

[youklebambou]

non pas de poil dans la main... non...ça fait 2 jour que je cherche comment faire mais comme je gère pas bien vba je tâtonne et je galère. quand je mettais dans mes recherches copier fichier csv je trouvais rien qui ressemblait à ce dont on avait déjà parler....bref j'y suis presque grâce a toi et je t'en remercie.
me reste plus qu'à comprendre la formule pour l'adapter

 

[youklebambou]

Hum.. si je veux que ma cellule A1 sois sur une feuille 1 et que la copie du csv sur une feuille 2 c'est faisable ou non???

 

[job75]

Bonjour youklebambou, le forum,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Dim dossier$, chemin$, nomfichier$, F As Worksheet
dossier = "B" 'nom du dossier cousin, à adapter
chemin = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & dossier
nomfichier = [A1] & ".csv" 'nom du fichier csv à copier
Set F = Feuil2 'CodeName à adapter
Application.ScreenUpdating = False
On Error Resume Next 'si le fichier n'existe pas
F.Cells.ClearContents 'RAZ
With Workbooks.Open(chemin & "\" & nomfichier).Sheets(1)
  .UsedRange.TextToColumns .UsedRange.Cells(1), xlDelimited, Semicolon:=True 'commande Convertir
  F.[A1].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count) = .UsedRange.Value
  F.[A1].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).Columns.AutoFit 'ajustement largeur
  .Parent.Close False
End With
If Application.CountA(F.UsedRange) Then F.Activate 'facultatif
End Sub

Fichiers zippés joints.

Pour tester j'ai copié les lignes 1:20 du fichier C2.csv sur 20 000 lignes.

La macro s'exécute en 7,2 secondes, c'est bien plus long qu'avec les formules de liaison.

Bonne journée.