Importer depuis plusieurs classeurs

Résolu/Fermé

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 - 29 juil. 2018 à 17:38
noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 - 30 juil. 2018 à 17:52

Bonjour les amis

j'ai pour but d'importer des données depuis d'autres classeurs qui se trouve dans
un même dossier mais la macro que je possède ne peut importer que d'un seul classeur
le but de la macro que cherche c'est qu'elle m'autorise à sélectionner tout
les fichiers excel que je désire et les importer dans dans le classeur source
et coller les un sous l'autre pour former un seul tableau

voila la macro que je veux ameliorer
Sub impt_data()

Application.ScreenUpdating = False

Dim Fich As String,
Fich = Application.GetOpenFilename
Workbooks.Open (Fich)
dim i as long
i = Cells(Rows.Count, 1).End(xlUp).Row
cd = ActiveSheet.Range("A5:Li")

ActiveWorkbook.Close

Range("A5:Li") = cd

End Sub

et merci d'avance

A voir également:

Importer depuis plusieurs classeurs
Importer contact - Guide
Importer favoris chrome - Guide
Importer favoris firefox - Guide
Importer calendrier outlook dans google agenda - Guide
Importer video youtube - Guide

5 réponses

Réponse 1 / 5

danielc0 Messages postés 847 Date d'inscription mardi 5 juin 2018 Statut Membre Dernière intervention 7 mai 2024 75
29 juil. 2018 à 19:26

Bonjour,

Essaie :

Sub impt_data()
  Application.ScreenUpdating = False
  Dim Fich As String
  Do While Fich <> "Faux"
    Fich = Application.GetOpenFilename
    Workbooks.Open (Fich)
    Dim i As Long
    i = Cells(Rows.Count, 1).End(xlUp).Row + 1
    cd = ActiveSheet.Range("A5:Li")
    ActiveWorkbook.Close False
    Range("A5:Li") = cd
  Loop
End Sub

Daniel

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 4
29 juil. 2018 à 19:40

salut Daniel
la macro s'arrete sur la 9 eme ligne : cd = ActiveSheet.Range("A5:Li")
et ne permet pas de sélectionner plusieurs fichiers pour les ouvrir, peut qu'on doit ajouter un "array" à "Application.GetOpenFilename"
merci infiniment

Réponse 2 / 5

danielc0 Messages postés 847 Date d'inscription mardi 5 juin 2018 Statut Membre Dernière intervention 7 mai 2024 75
29 juil. 2018 à 20:55

Elle ne permet pas de sélectionner plusieurs fichiers à la fois. Après chaque fichier, elle demande le classeur à ouvrir. Quant à l'erreur, regarde la valeur de "i". Il faudrait aussi préciser la feuille avec laquelle tu veux travailler.

Daniel

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 4
29 juil. 2018 à 21:18

Salut daniel les feuilles source et destination s'appellent ' data'

Réponse 3 / 5

danielc0 Messages postés 847 Date d'inscription mardi 5 juin 2018 Statut Membre Dernière intervention 7 mai 2024 75
30 juil. 2018 à 11:28

Sub impt_data()
  Application.ScreenUpdating = False
  Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range
  Dim Wbk As Workbook
  Set Sh = ThisWorkbook.Sheets("data")
  Fich = Application.GetOpenFilename
  Do While Fich <> "Faux"
    L = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row + 1
    Set Wbk = Workbooks.Open(Fich)
    With Wbk.Sheets("data")
      I = .Cells(Rows.Count, 1).End(xlUp).Row
      Set CD = .Range("A5:L" & I)
      Sh.Cells(L, 1).Resize(CD.Rows.Count, 12).Value = CD.Value
      Wbk.Close False
    End With
  Loop
End Sub

Daniel

Réponse 4 / 5

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 4
30 juil. 2018 à 12:18

salut daniel et merci pour votre effort
le code s’arrête au niveau de la 5 eme ligne : Set Sh = ThisWorkbook.Sheets("data")
j'ai essayé le code que vous avez posté hier tout en le modifiant un un peu il efficace mais je préfére utiliser "Application.GetOpenFilename" pour selectionner d'un seul coup tout les fichiers excel dans le dossier contenant pour les mettre l'un sous l'autre pour former un seul tableau :

Sub impt_data()
Application.ScreenUpdating = False
Dim Fich As String
Do While Fich <> "Faux"
Fich = Application.GetOpenFilename
Workbooks.Open (Fich)
Dim i As Long
i = Cells(Rows.Count, 2).End(xlUp).Row + 1
CD = ActiveSheet.Range(Cells(5, 1), Cells(i, 12))
ActiveWorkbook.Close False
Dim j As Long
j = Cells(Rows.Count, 2).End(xlUp).Row + 1
Range(Cells(5 + j, 1), Cells(i + j, 12)) = CD
Loop
End Sub

danielc0 Messages postés 847 Date d'inscription mardi 5 juin 2018 Statut Membre Dernière intervention 7 mai 2024 75
30 juil. 2018 à 12:50

Voici la boucle sur les choix de fichiers :

  Application.ScreenUpdating = False
  Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range
  Dim Wbk As Workbook, Coll
  Set Sh = ThisWorkbook.Sheets("data")
  Coll = Application.GetOpenFilename(, , , , True)
  If Coll Is Nothing Then Exit Sub
  For I = 1 To UBound(Coll)
    Fich = Coll(I)
    Set Wbk = Workbooks.Open(Fich)
  Next

Pour le reste, ca dépend si le classeur est celui qui contient la macro. Fais-moi parvenir ce dernier.

Daniel

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 4
30 juil. 2018 à 13:19

salut
j'ai envoyé dans ce lien un exemple des fichiers et du dossier pour que vous puissier tester la macro
merci encore une fois
https://www.cjoint.com/c/HGElqxPzkoi

danielc0 Messages postés 847 Date d'inscription mardi 5 juin 2018 Statut Membre Dernière intervention 7 mai 2024 75
30 juil. 2018 à 14:38

Sub impt_data()
  Application.ScreenUpdating = False
  Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range
  Dim Wbk As Workbook, Coll, K As Long
  Set Sh = ThisWorkbook.Sheets("data")
  Coll = Application.GetOpenFilename(, , , , True)
  For K = 1 To UBound(Coll)
    Fich = Coll(K)
    Set Wbk = Workbooks.Open(Fich)
    L = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row + 1
    With Wbk.Sheets("data")
      I = .Cells(.Rows.Count, 2).End(xlUp).Row
      Set CD = .Range("A5:L" & I)
      Sh.Cells(L, 1).Resize(CD.Rows.Count, 12).Value = CD.Value
      Wbk.Close False
    End With
  Next K
End Sub

Daniel

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 4
30 juil. 2018 à 14:53

salut daniel
le code est très intéressant mais je reçois sur mon fichier source uniquement les donnés d'un seul classeur , le dernier en sélection mais pas les autres
merci daniel pour votre aide

danielc0 Messages postés 847 Date d'inscription mardi 5 juin 2018 Statut Membre Dernière intervention 7 mai 2024 75
30 juil. 2018 à 15:47

Tu as raison :

Sub impt_data()
  Application.ScreenUpdating = False
  Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range
  Dim Wbk As Workbook, Coll, K As Long
  Set Sh = ThisWorkbook.Sheets("data")
  Coll = Application.GetOpenFilename(, , , , True)
  For K = 1 To UBound(Coll)
    Fich = Coll(K)
    Set Wbk = Workbooks.Open(Fich)
    L = Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row + 1
    With Wbk.Sheets("data")
      I = .Cells(.Rows.Count, 2).End(xlUp).Row
      Set CD = .Range("A5:L" & I)
      Sh.Cells(L, 1).Resize(CD.Rows.Count, 12).Value = CD.Value
      Wbk.Close False
    End With
  Next K
End Sub

Daniel

noe2008 Messages postés 183 Date d'inscription vendredi 18 juillet 2008 Statut Membre Dernière intervention 9 novembre 2023 4
30 juil. 2018 à 17:52

Merci Daniel pour votre aide ça marche d'une façon magique

Discussions similaires

activer import/export sur Outlook 365 sur un macbook pro

"Ce classeur comporte des liaisons avec un autre classeur"

Da vinci resolve 16 problème d'importation vidéo

Discussions similaires

Newsletters