Discussion :

[DraGula]

Bonjour ici !

Pour un besoin de reporting tout bête, je planche sur un vba basé sur un exemple du forum.
Mon besoin : Récupérer le contenu des cellules C2/D2/E2/F2 des feuilles "portables" et "fixes" depuis une 100ène de fichier XLSX.
Et coller le tout dans un fichier "recap" vers les cellules A1/B1/C1/D1 de la feuille "SN".
J'ai essayé quelque le code ci-dessous, mais il ne ce passe rien...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Transferer()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = True
 
Chemin = ThisWorkbook.Path
FName = Dir(Chemin & "\" & "*.xlsx")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
Lg = 10
 
For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "RECUP.XLSM" Then
Workbooks.Open Filename:=Chemin & "/" & NomFichier
 
On Error Resume Next
 
With Workbooks(NomFichier)
.Sheets("portables").Range("C2").Copy ThisWorkbook.Sheets("SN").Range("A" & Lg)
.Sheets("portables").Range("D2").Copy ThisWorkbook.Sheets("SN").Range("B" & Lg)
.Sheets("portables").Range("E2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
.Sheets("portables").Range("F2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
.Sheets("fixes").Range("C2").Copy ThisWorkbook.Sheets("SN").Range("A" & Lg)
.Sheets("fixes").Range("D2").Copy ThisWorkbook.Sheets("SN").Range("B" & Lg)
.Sheets("fixes").Range("E2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
.Sheets("fixes").Range("F2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
 
.Close
 
Lg = Lg + 1
 
End With
End If
 
Next
 
End Sub

Si vous avez une idée ? Ne serais-ce qu'une petite piste
Un grand merci !!!

[Marc-L]

Bonjour,

afin d'éviter un code à la hussarde et de comprendre enfin ce qu'il se passe,
supprimer la ligne n°16 ou tout du moins, la mettre en commentaire ‼

Mettre aussi en commentaire la ligne n°8 car équivalente à la variable Chemin, ne sert donc à rien !

Edit : je n'avais pas vu que cette ligne n°8 conditionne la boucle …
Mais alors à quoi bon la fonction Dir alors ?

C'est l'un ou l'autre, pas besoin des deux et Dir suffit, pas besoin de FSO …

[Daniel.C]

Bonsoir,

Ca devrait fonctionner... Enlève la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error Resume Next

Si tu as une erreur, elle s'affichera.

[DraGula]

Bonjour !

J'ai enlevé le "On error..."
Malheureusement ça ne fonctionne toujours pas, et pire il ne me toujours rien.

C'est comme si l'instruction fonctionnait mais qu'il n'arrive pas à lire mes fichier xlsx !?

[NVCfrm]

bonjour,

C'est comme si l'instruction fonctionnait mais qu'il n'arrive pas à lire mes fichier xlsx !?

ça peut être certaines imperfections de ton code.

ici il me semble que tu copies simultanément les données des deux feuilles sources vers la même plage A/B/C/D de la feuille "SN" ThisWorkbook.Sheets("SN").Range("C" & Lg).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
.Sheets("portables").Range("C2").Copy ThisWorkbook.Sheets("SN").Range("A" & Lg)
...
.Sheets("fixes").Range("C2").Copy ThisWorkbook.Sheets("SN").Range("A" & Lg)
...

observes les adresses de destination de la copie pour les deux feuilles.

il te faut aussi simplifier l'écriture du code avec des variables objets et l'instruction de copie de 4 lignes de code en une ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
.Sheets("portables").Range("C2:F2").Copy ThisWorkbook.Sheets("SN").Range("A" & lg & ":D" & lg)
 
ou avec des variables
Dim dest As Range, fichier As Worksheet
 
Set dest = Worksheets("SN").Range("A10:D10")
...
...
   lg = 0
 
   for each ...
   lg = lg + 1
 
   Set fichier = Workbooks("x").Worksheets("portables")
   fichier.Range("C2:F2").Copy dest.Rows(lg)
 
   'décalage à droite pour ne pas écraser la première copie.
   Set fichier = Workbooks("x").Worksheets("fixes")
   fichier.Range("C2:F2").Copy dest.Rows(lg).Offset(, dest.Columns.Count + 1)

[DraGula]

Bonjour à tous,

Désolé mais je ne m'en sort toujours pas... Maintenant j'obtiens une erreur 91
Je pense avoir suivi vos conseils, nettoyé mon code. Toujours pareil.
Du coup j'ai uploadé un exemple simple, si vous trouvez une coquille

http://www.sendspace.com/filegroup/8...QmPUveZETG6V7R

2 fichiers xlsx contenant mes données
1 fichier xlsm "recup.xlsm" fichier qui censé récupéré mes données de mes 2 fichiers xlsx...

Merci

[DraGula]

Problèmé résolu,

Voici pour info la macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
 
Sub Transferer()
Dim Chemin As String, NomFichier As String
Dim Dest As Range
Dim Lg As Long
 
  Application.ScreenUpdating = False
 
  Chemin = ThisWorkbook.Path
  Set Dest = Worksheets("SN").Range("A10:D10")
 
  Lg = 10
  NomFichier = Dir(Chemin & "\" & "*.xlsx")
  Do While NomFichier <> ""
    If Not NomFichier = ThisWorkbook.Name Then
      With Workbooks.Open(Filename:=Chemin & "\" & NomFichier)
        Lg = Lg + 1
        .Sheets("HKN portables").Range("C2:F2").Copy Dest.Rows(Lg)
        .Sheets("HKN UC").Range("C2:F2").Copy Dest.Rows(Lg).Offset(, Dest.Columns.Count + 1)
        .Close
      End With
    End If
    NomFichier = Dir
  Loop
End Sub