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

R
  • Question
XL 2016 Formule pour additionner des données
Réponses
10
Affichages
413
JHA
J
1
  • Question
Microsoft 365 Import de données depuis fichiers - lignes manquantes
Réponses
6
Affichages
353
1dudu9
1
A
  • Résolu(e)
XL 2016 Alimentation d'un fichier selon données sélectionnées via une ComboBox
Réponses
3
Affichages
301
Aldonanou
A
merinos
  • Résolu(e)
Power Query Import de valeurs registre
Réponses
13
Affichages
262
merinos
merinos
Y
  • Résolu(e)
XL 2016 Importer des données depuis un calendrier liste
Réponses
6
Affichages
385
YANNISE
Y
N
  • Question
XL 2021 Valeur qui ne suis pas lors d'un filtre
Réponses
1
Affichages
222
fanch55
fanch55
P
  • Résolu(e)
XL pour MAC Extraire les données d'un tableau en fonction du choix de l'année
2
Réponses
21
Affichages
1 K
pilou010
P
P
  • Question
Microsoft 365 extraction de valeur d'un tableau avec critère mois et année
Réponses
13
Affichages
419
JHA
J
J
  • Question
XL 2021 SOMME INDIRECT AVEC PLUSIEUR CONDITIONS
Réponses
4
Affichages
136
Jimmy_fidu
J
B
  • Résolu(e)
Power Query récupérer fichier excel toujours de la première à la nième colonne
Réponses
7
Affichages
311
Cousinhub
Cousinhub

Membres actuellement en ligne

10 membres et 80 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
312 204
Messages
2 086 198
Membres
103 153
dernier inscrit
SamirN