Discussion :

[facteur]

Bonjour,

J'ai crée un petit code vba qui me permet de selectionner une valeur de cellule dans plusieurs fichiers d'une même repertoir et de coller ces valeur dans un autre fichier excel ( copie en colonne B).
La valeur à copier se trouve toujours dans la cellule E12 des fichiers (onglet "Livraison Conforme).

On me demande maintenant de selectionner également la date de ces même fichiers et de les coller dans le fichier excel (colonne A ).
La date à copier se trouve toujours dans la cellule E9 des fichiers du même repertoire.

Or je ne sais pas comment selectionner en même temps deux cellules d'une même fichier et de coller ces cellules dans le fichier excel en sachant que la cellule date doit etre en B1 et la valeur en A1..

Voici le code vba que j'ai crée pour selectionner uniquement la valeur contenue dans la cellule E12

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
38
39
40
41
42
43
44
45
46
47
Sub Transferer()
 
Dim jour As Date
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = True
 
DerLg = Range("B65536").End(xlUp).Row + 1
 
Range("B2:B" & DerLg).Delete
 
 
Chemin = "P:adresse du repertoire"
FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
Lg = 2
 
 
 
For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "fichier excel.xls" Then
Workbooks.Open Filename:=Chemin & "/" & NomFichier
 
On Error Resume Next
 
With Workbooks(NomFichier)
.Sheets("Livraison Conforme").Range("E11").Copy
.Close False
 
 
Workbooks("fichier excel.xls").Worksheets("feuil1").Activate
Range("B" & Lg).PasteSpecial
 
Lg = Lg + 1
 
 
End With
 
Lg = Lg + 1
 
 
End If
 
Next
 
End Sub

[parmi]

Bonjour,

En supposant que la macro est dans le fichier "fichier excel.xls", plutôt que

Code :

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

1
2
3
4
5
6
7
8
9
10
With Workbooks(NomFichier)
.Sheets("Livraison Conforme").Range("E11").Copy
.Close False
 
Workbooks("fichier excel.xls").Worksheets("feuil1").Activate
Range("B" & Lg).PasteSpecial
 
Lg = Lg + 1
 
End With

Peut-être essayer comme ceci

Code :

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

1
2
3
4
Workbooks("fichier excel.xls").Worksheets("feuil1").Range("A" & Lg) = ActiveWorkbook.Sheets("Livraison Conforme").Range("E12")
Workbooks("fichier excel.xls").Worksheets("feuil1").Range("B" & Lg) = ActiveWorkbook.Sheets("Livraison Conforme").Range("E9")
Lg = Lg + 1
ActiveWorkbook.Close False

[facteur]

Bonjour Parmi

ma macro se trouve dans le PERSO.xls

[parmi]

Tu peux aussi y aller avec les noms des workbooks plutôt que ActiveWorkbook ou ThisWorkbook.

Code :

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

1
2
3
4
Workbooks("fichier excel.xls").Worksheets("feuil1").Range("A" & Lg) = Workbooks(NomFichier).Sheets("Livraison Conforme").Range("E12")
Workbooks("fichier excel.xls").Worksheets("feuil1").Range("B" & Lg) = Workbooks(NomFichier).Sheets("Livraison Conforme").Range("E9")
Lg = Lg + 1
Workbooks(NomFichier).Close False

[facteur]

Parmi,

On a eu la même approche ...voila ceque j'ai fait ..

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
With Workbooks(NomFichier)
.Sheets("Livraison Conforme").Range("E11").Copy Workbooks("fichier excel.xls").Worksheets("feuil1").Range("B" & Lg)
.Sheets("Livraison Conforme").Range("E9").Copy Workbooks("fichier excel.xls").Worksheets("feuil1").Range("A" & Lg)
.Close False
 
Lg = Lg + 1
 
End With
 
End If
 
Next

Et merci encore de ton soutien Parmi

[facteur]

Bonjour parmi,

je reviens vers toi pour une aide à cette macro qui liste les cellules d'une feuille excel vers une autre feuilles Excel.

je resume ce que j'ai fait:
J'ai crée une macro qui me permet de selectionner les valeurs des cellule E9 (cellule date) et E12 (cellule valeurs) dans plusieurs fichiers d'un même repertoire et de les coller dans un autre fichier excel.
Ces fichiers Excel sont classés dans le repertoir de cette manière :
"bordereau du yymmjj".
Il faut savoir que ce repertoire contient les fichiers Excel depuis 2010; ce qui sous entend que le repertoir contient les "bordereau du 100102" au "bordereau du 140213".

Le service production souhaite recevoir chaque debut de mois , la liste des cellules E9 et E12 pour le mois écoulé.

Comment inserer dans ma macro un bout de code où je demanderais de copier les cellules E9 et E12 des bordereaux commençant par 1401 ou 1402 etc...

Est ce possible ?...

Voici ma 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
27
28
29
30
31
32
33
34
35
36
37
38
Sub Transferer()
 
Dim jour As Date
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = True
 
DerLg = Range("B65536").End(xlUp).Row + 1
 
Range("B2:B" & DerLg).Delete
 
 
Chemin = "P:adresse du repertoire"
FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
Lg = 2
 
 
 
For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "fichier excel.xls" Then
Workbooks.Open Filename:=Chemin & "/" & NomFichier
 
On Error Resume Next
 
With Workbooks(NomFichier)
.Sheets("Livraison Conforme").Range("E11").Copy Workbooks("fichier excel.xls").Worksheets("feuil1").Range("B" & Lg)
.Sheets("Livraison Conforme").Range("E9").Copy Workbooks("fichier excel.xls").Worksheets("feuil1").Range("A" & Lg)
.Close False
 
Lg = Lg + 1
 
End With
 
End If
 
End Sub .