Import de valeur d'un fichier fermé

K

Kenny972

XLDnaute Nouveau
Bonjour à tous,

Après avoir fait plusieurs recherches et trouvé des réponses qui répondait partiellement à ce que je recherche, je sollicite votre aide. J'ai des fichiers mensuels et un fichier de synthèse, j'aimerais importer des données de mes fichiers mensuels vers le fichier de synthèse.

J'aimerais avec une macro pouvoir sélectionner un fichier mensuel (Janvier-17) et importer les valeurs de la cellule A1 de la feuil1 dans le classeur ouvert "synthèse" dans la cellule A1, jusque là j'ai réussi à le faire.

Je bloque à partir du moment où il faut récupérer les valeurs dans différents onglets du fichier Janvier-17, par exemple à partir de l'onglet feuil2, feuil3 etc, pour les copier en A2, A3, etc dans le classeur synthèse. Egalement, si j'ai 2 valeurs à importer en A1 et A2 par exemple quel serait le code?

Je vous remercie par avance.
 
Trier par date Trier par votes
O

olive323

XLDnaute Occasionnel
Bonjour,

Une idée avec ce code peut etre.

Code: 
Sub maj2()

 
Const fichier As String = "BILAN_MATIERE_2017.csv"
Dim wbkSource As Workbook
Dim wbkDestination As Workbook
Dim classeur As Workbook
Set classeur = Application.Workbooks.Open("H:\Reports\LOGYS\BILAN_MATIERE_2017.csv", , local:=True)
Set wbkSource = Workbooks(fichier)
Set shtSource = wbkSource.Worksheets("BILAN_MATIERE_2017")


If Not miseablanc Then
            Workbooks("Ratio papier 2017.xlsm").Sheets("bilan_matiere").Range("A1:aw1048576").ClearContents
            miseablanc = True
      End If

Workbooks(fichier).Sheets("BILAN_MATIERE_2017").Range("a1:aw1048576").Copy _
        Destination:=Workbooks("Ratio papier 2017.xlsm").Sheets("bilan_matiere").Range("a1:aw1048576")
       
Workbooks(fichier).Close False

    Sheets("Ratio de stockage").Select

   
   
  
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Kenny972, olive323,
Kenny972 à dit:
Le problème de ce code c'est qu'il faut indiquer le chemin, si il change d'une année sur l'autre cela posera un problème; d'où l'idée de pouvoir sélectionner le fichier.
Cliquez pour agrandir...
Ce n'est vraiment pas un problème et c'est très classique, utiliser :
Code: 
Dim FichierAouvrir As Variant
Dim classeur As Workbook
'----
FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
Set classeur = Workbooks.Open(FichierAouvrir)
'----
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Et pour importer les valeurs des cellules A1 des feuilles il suffit de faire une boucle :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, classeur As Workbook, w As Worksheet, i As Integer
FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
Application.ScreenUpdating = False
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter
  .[A:A] = "" 'RAZ
  For Each w In classeur.Worksheets
    i = i + 1
    .Cells(i, 1) = w.[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Avec un complément pour éviter l'ouverture d'un fichier de même nom que celui du ThisWorkbook :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, classeur As Workbook, w As Worksheet, i As Integer
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
Application.ScreenUpdating = False
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter
  .[A:A] = "" 'RAZ
  For Each w In classeur.Worksheets
    i = i + 1
    .Cells(i, 1) = w.[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
 
Vote positif 0 Vote négatif
K

Kenny972

XLDnaute Nouveau
job75 à dit:
Re,
Bonjour,

Merci Job 75, ça marche super bien et c'est ce que je cherchais.

Par contre comment faire si je veux récupérer seulement les données des onglets nommés "feuil1" et "feuil3" par exemple ? Et pas toutes les valeurs en A1 de tous les onglets?

Merci encore.

Avec un complément pour éviter l'ouverture d'un fichier de même nom que celui du ThisWorkbook :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, classeur As Workbook, w As Worksheet, i As Integer
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
Application.ScreenUpdating = False
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter
  .[A:A] = "" 'RAZ
  For Each w In classeur.Worksheets
    i = i + 1
    .Cells(i, 1) = w.[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Kenny972,
Kenny972 à dit:
Par contre comment faire si je veux récupérer seulement les données des onglets nommés "feuil1" et "feuil3" par exemple ?
Cliquez pour agrandir...
Avez-vous seulement cherché un peu ?

Car c'est un bon exercice pour progresser en VBA :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, a, classeur As Workbook, i As Integer
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("Feuil1", "Feuil3") 'noms des feuilles, à adapter
Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter
  .[A:A] = "" 'RAZ
  For i = 0 To UBound(a)
    .Cells(i + 1, 1) = classeur.Sheets(a(i)).[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
 
Vote positif 0 Vote négatif
K

Kenny972

XLDnaute Nouveau
Job75, merci de votre réponse.
Ce n'est pas faute d'avoir cherché, je ne connaissais pas cette fonction Array, j'étais loin du compte. En général, j'arrive à faire des choses "simples"; en cherchant un peu j'avais réussi à bricoler un code (ci-dessous), mais je me heurtais toujours au même problème.

Dim ws_q As Worksheet
Dim ws_x As Worksheet
Set ws_q = ActiveSheet
Dim x_lr&
Dim q_lr&
Dim T1()
Application.ScreenUpdating = False

If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub
Set ws_x = Worksheets("feuil1")
x_lr = ws_x.Range("A65000").End(xlUp).Row

If x_lr = 1 Then ActiveWorkbook.Close: Exit Sub
With ws_x
T1 = .Range("A1:A" & (x_lr) + Abs(x_lr = 2))
ActiveWorkbook.Close
End With

job75 à dit:
Bonjour Kenny972,

Avez-vous seulement cherché un peu ?

Car c'est un bon exercice pour progresser en VBA :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, a, classeur As Workbook, i As Integer
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("Feuil1", "Feuil3") 'noms des feuilles, à adapter
Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter
  .[A:A] = "" 'RAZ
  For i = 0 To UBound(a)
    .Cells(i + 1, 1) = classeur.Sheets(a(i)).[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Kenny972, cathodique,

Vous voulez donc maintenant importer les données en colonne T :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, a, classeur As Workbook, derlig, i
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("Feuil1", "Feuil3") 'noms des feuilles, à adapter
Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
derlig.Cells(Rows.Count, "t").End(xlUp).Row
With ThisWorkbook.ActiveSheet 'feuille à adapter
  If .FilterMode Then .ShowAllData 'si la feuille est filtrée
  derlig = .Cells(.Rows.Count, "T").End(xlUp).Row + 1
  For i = 0 To UBound(a)
    .Cells(derlig + i, "T") = classeur.Sheets(a(i)).[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
 
Vote positif 0 Vote négatif
K

Kenny972

XLDnaute Nouveau
Bonjour Job 75 et cathodique ,
Pour être plus précis, tout fonctionne avec le code que j'ai tenté d'adapté ci-dessous, sauf que j'aimerais que les valeurs s'incrémentent les unes en dessous des autres de la colonne T à la colonne V, à chaque fois que je sélectionne un fichier. Jusqu'à présent je n'ai réussi qu'a écraser mes données précédentes avec des nouvelles.


Sub Importer()
Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i As Integer
Dim dl As Long

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("6002-atelier") 'noms des feuilles, à adapter
b = Array("6000-atelier")
c = Array("6001-atelier")

Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter

dl = Range("t" & Rows.Count).End(xlUp).Row + 1

For i = 0 To UBound(a)
.Cells(dl + i + 2, 20) = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule E30
Next

For i = 0 To UBound(b)
.Cells(dl + i + 2, 21) = classeur.Sheets(b(i)).[E30]
Next
For i = 0 To UBound(c)
.Cells(dl + i + 2, 22) = classeur.Sheets(c(i)).[E30]
Next

End With
classeur.Close False 'referme le classeur
End Sub



job75 à dit:
Bonjour Kenny972, cathodique,

Vous voulez donc maintenant importer les données en colonne T :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, a, classeur As Workbook, derlig, i
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("Feuil1", "Feuil3") 'noms des feuilles, à adapter
Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
derlig.Cells(Rows.Count, "t").End(xlUp).Row
With ThisWorkbook.ActiveSheet 'feuille à adapter
  If .FilterMode Then .ShowAllData 'si la feuille est filtrée
  derlig = .Cells(.Rows.Count, "T").End(xlUp).Row + 1
  For i = 0 To UBound(a)
    .Cells(derlig + i, "T") = classeur.Sheets(a(i)).[A1] 'importe la valeur de la cellule A1
  Next
End With
classeur.Close False 'referme le classeur
End Sub
A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i%
Dim dl1&, dl2&, dl3&

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("6002-atelier") 'noms des feuilles, à adapter
b = Array("6000-atelier")
c = Array("6001-atelier")

Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter

If .FilterMode Then .ShowAllData 'si la feuille est filtrée
dl1 = .Range("t" & .Rows.Count).End(xlUp).Row + 1
dl2 = .Range("u" & .Rows.Count).End(xlUp).Row + 1
dl3 = .Range("v" & .Rows.Count).End(xlUp).Row + 1

For i = 0 To UBound(a)
.Cells(dl1 + i + 2, 20) = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule E30
Next

For i = 0 To UBound(b)
.Cells(dl2 + i + 2, 21) = classeur.Sheets(b(i)).[E30]
Next

For i = 0 To UBound(c)
.Cells(dl3 + i + 2, 22) = classeur.Sheets(c(i)).[E30]
Next

End With
classeur.Close False 'referme le classeur
End Sub
Nota : le + 2 fait sauter 2 lignes, c'est ce que vous voulez ? Ce serait mieux de l'inclure dans dl1 dl2 dl3...

Mais s'il n'y a qu'un seul nom de feuille dans les tableaux a b c on peut s'en passer :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, classeur As Workbook
Dim dl1&, dl2&, dl3&

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom

Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter

If .FilterMode Then .ShowAllData 'si la feuille est filtrée
dl1 = .Range("t" & .Rows.Count).End(xlUp).Row + 3
dl2 = .Range("u" & .Rows.Count).End(xlUp).Row + 3
dl3 = .Range("v" & .Rows.Count).End(xlUp).Row + 3

.Cells(dl1, 20) = classeur.Sheets("6002-atelier").[E30] 'importe la valeur de la cellule E30
.Cells(dl2, 21) = classeur.Sheets("6000-atelier").[E30]
.Cells(dl3, 22) = classeur.Sheets("6001-atelier").[E30]

End With
classeur.Close False 'referme le classeur
End Sub
A+
 
Vote positif 0 Vote négatif
K

Kenny972

XLDnaute Nouveau
Job75, un GRAND MERCI! c'est exactement ça, je n'avais pas besoin de sauter 2 lignes de ligne le +1 suffit.

job75 à dit:
Re,
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i%
Dim dl1&, dl2&, dl3&

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
a = Array("6002-atelier") 'noms des feuilles, à adapter
b = Array("6000-atelier")
c = Array("6001-atelier")

Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter

If .FilterMode Then .ShowAllData 'si la feuille est filtrée
dl1 = .Range("t" & .Rows.Count).End(xlUp).Row + 1
dl2 = .Range("u" & .Rows.Count).End(xlUp).Row + 1
dl3 = .Range("v" & .Rows.Count).End(xlUp).Row + 1

For i = 0 To UBound(a)
.Cells(dl1 + i + 2, 20) = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule E30
Next

For i = 0 To UBound(b)
.Cells(dl2 + i + 2, 21) = classeur.Sheets(b(i)).[E30]
Next

For i = 0 To UBound(c)
.Cells(dl3 + i + 2, 22) = classeur.Sheets(c(i)).[E30]
Next

End With
classeur.Close False 'referme le classeur
End Sub
Nota : le + 2 fait sauter 2 lignes, c'est ce que vous voulez ? Ce serait mieux de l'inclure dans dl1 dl2 dl3...

Mais s'il n'y a qu'un seul nom de feuille dans les tableaux a b c on peut s'en passer :
Code: 
Sub Importer()
Dim FichierAouvrir As Variant, classeur As Workbook
Dim dl1&, dl2&, dl3&

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom

Application.ScreenUpdating = False
On Error Resume Next 'sécurité, si une feuille n'existe pas
Set classeur = Workbooks.Open(FichierAouvrir)
With ThisWorkbook.ActiveSheet 'feuille à adapter

If .FilterMode Then .ShowAllData 'si la feuille est filtrée
dl1 = .Range("t" & .Rows.Count).End(xlUp).Row + 3
dl2 = .Range("u" & .Rows.Count).End(xlUp).Row + 3
dl3 = .Range("v" & .Rows.Count).End(xlUp).Row + 3

.Cells(dl1, 20) = classeur.Sheets("6002-atelier").[E30] 'importe la valeur de la cellule E30
.Cells(dl2, 21) = classeur.Sheets("6000-atelier").[E30]
.Cells(dl3, 22) = classeur.Sheets("6001-atelier").[E30]

End With
classeur.Close False 'referme le classeur
End Sub
A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif

Discussions similaires

vgendron
  • Question
Power Query [Resolu] Importer plusieurs fichiers excel provenant de dossiers différents sur sharepoint
Réponses
6
Affichages
1 K
Staple1600
Staple1600
O
  • Résolu(e)
XL 2021 VBA - Importer des données
Réponses
5
Affichages
236
OULDTA
O
C
  • Question
Microsoft 365 Créer un synthèse de plusieurs onglets
Réponses
7
Affichages
422
cdric78
C
C
  • Question
XL 2021 Dernière ligne d'un fichier fermé
Réponses
7
Affichages
519
Chris 33
C
N
  • Résolu(e)
XL 2019 Joindre des données de plusieurs feuilles
Réponses
4
Affichages
562
Nasseuz
N
S
  • Résolu(e)
XL 2019 Copie Valeur Feuille VBA
Réponses
9
Affichages
455
Stepha
S
kkamadou
  • Question
importation de donnees dans un fichier excel dans un formulaire
Réponses
3
Affichages
424
kkamadou
kkamadou
Dudu2
  • Question
XL 2016 VBA - Exporter / Importer un Projet VBA complet
5 6 7
Réponses
104
Affichages
4 K
Dudu2
Dudu2
P
  • Résolu(e)
XL 2010 Formule excel synthese arrets
Réponses
2
Affichages
255
pomunho
P
R
  • Question
XL 2016 Formule pour additionner des données
Réponses
10
Affichages
618
JHA
J

Membres actuellement en ligne

1 membres et 23 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki