Importer des données de plusieurs feuilles Excel

Le 28/04/2015 à 18:01

Bonsoir, je suis tout nouveau en vba. Ma démarche est la suivante:

Je souhaite importer des données issues d'autres feuilles excel dans une feuille excel particulière.

J'ai trouvé un code pour réaliser cela à partir d'un seul classeur (l'import des données ne se réalise pas dans la bonne feuille de mon classeur de destination).

Ce que j'aimerai obtenir c'est, dès lors que je réitère l'opération pour importer des données issues d'un autre classeur, coller ces données à la suite de celles précédemment importer.

Et si possible intégrer un contrôle qui empêche que deux lignes avec des données similaires soient présentes dans la feuille de destination.

J'espère avoir été clair. Je joins 3 classeurs: le classeur avec la feuille de destination et 2 classeurs contenant les données à importer.

Merci par avances pour votre aide et vos conseils.

78destination.xlsm (28.53 Ko)

37classeur-1.zip (5.50 Ko)

39classeur-2.xls (20.00 Ko)

Le 28/04/2015 à 21:47

Bonsoir BarbotLivide, bonsoir le forum,

Peut-être comme ça :

Sub test()
Dim a As Variant
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets("Import ") 'définit l'onglet destination OD
ChDrive "C:"    ' Choix du lecteur
ChDir "C:\"    'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", , "Sélection de vos fichiers excel", , True)
Select Case TypeName(a)
    Case Is = "Boolean"
        Exit Sub
    Case Else
        For B = LBound(a) To UBound(a)
        Workbooks.Open a(B)
    Next
End Select
Set CS = ActiveWorkbook 'définit le classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source OS
'définit la cellule de destination DEST (B1 si C1 est vide, sinon la première cellule vide de la colonne B) de l'onglet OD
Set DEST = IIf(OD.Range("C1").Value = "", OD.Range("B1"), OD.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0))
OS.Range("B1").CurrentRegion.Copy 'copie les données de l'onglet source
DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs dans DEST
CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
OD.Range("B1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'supprime les doublons des colonnes B et C
CD.Sheets("Interface utilisateur").Activate 'active l'onglet "Interface utilisateur"
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub

Le 29/04/2015 à 10:31

Merci pour cette réponse!

Cependant, je n'arrive pas à modifier le code pour l'adapter au type de fichier que j'utilise habituellement.

Les données du 1er classeur sont importées correctement mais pas celles du 2nde classeur.

Je joins le classeur destination tel qu'il apparait après les 2 importations.

Je joins les 3 classeurs en question. (classeur destination et classeurs avec données à importer)

Encore merci pour votre réponse qui m'a tout de même été précieuse.

38client-1.xlsx (40.85 Ko)

46destination.xlsm (38.00 Ko)

Le 29/04/2015 à 10:55

Après vérification les données issues du 1er fichier sont également mal importées, certaines lignes n'apparaissent pas dans le fichier destination.

Le 29/04/2015 à 11:02

Bonjour,

joindre un classeur résultat .xlsx (sans code) à partir des données des classeurs source

et expliquer enfin clairement & exhaustivement les tenants & les aboutissants (ex: critères du contrôle) …

Poster aussi le code en utilisant l'icone dédiée même si je me doute

qu'il n'est pas dans l'efficience en utilisant un filtre avancé par exemple …

Le 29/04/2015 à 11:36

Bonjour Marc L, je ne suis pas sur de comprendre votre demande mais je vais tâcher d'éclaircir la mienne.

Je joins un classeur présentant le résultat attendu.

J'ai par ailleurs modifié quelques éléments d'un de mes classeurs contenant les données d'importantion, je le joint avec.

Voici le code:

    Sub test()
    Dim a As Variant
    Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
    Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
    Dim CS As Workbook 'déclare la variable CS (Classeur Source)
    Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
    Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

    Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
    Set CD = ThisWorkbook 'définit le classeur destination CD
    Set OD = CD.Sheets("Import ") 'définit l'onglet destination OD
    ChDrive "C:"    ' Choix du lecteur
    ChDir "C:\"    'Choix du répertoire
    a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", , "Sélection de vos fichiers excel", , True)
    Select Case TypeName(a)
        Case Is = "Boolean"
            Exit Sub
        Case Else
            For B = LBound(a) To UBound(a)
            Workbooks.Open a(B)
        Next
    End Select
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Sheets(1) 'définit l'onglet source OS
    'définit la cellule de destination DEST (B1 si C1 est vide, sinon la première cellule vide de la colonne B) de l'onglet OD
    Set DEST = IIf(OD.Range("C1").Value = "", OD.Range("B1"), OD.Cells(Application.Rows.Count, 21).End(xlUp).Offset(1, 0))
    OS.Range("C6").CurrentRegion.Copy 'copie les données de l'onglet source
    DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs dans DEST
    CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
    OD.Range("C1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 20), Header:=xlNo 'supprime les doublons des colonnes B et C
    CD.Sheets("Interface utilisateur").Activate 'active l'onglet "Interface utilisateur"
    Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
    End Sub

Merci pour votre compréhension.

52client-2.xlsx (26.60 Ko)

68resultat.xlsx (53.86 Ko)

Le 29/04/2015 à 11:40

Reste à préciser clairement & exhaustivement les critères de ceci :

Didier BarbotLivide a écrit :
intégrer un contrôle qui empêche que deux lignes avec des données similaires soient présentes dans la feuille de destination.

Le 29/04/2015 à 11:45

Pardonnez-moi pour cette imprécision:

si deux lignes sont strictement identiques, des colonnes A à V je souhaite qu'il n'y en ai qu'une seule qui apparaisse.

Merci

Le 29/04/2015 à 12:15

Bonjour le fil, bonjour le forum,

Quelle perte de temps inutile ! Pourquoi de ne pas commencer par fournir les bons fichiers ?...

Le code modifié :

Sub test()
Dim a As Variant
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets("Import ") 'définit l'onglet destination OD
ChDrive "C:"    ' Choix du lecteur
ChDir "C:\"    'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", , "Sélection de vos fichiers excel", , True)
Select Case TypeName(a)
    Case Is = "Boolean"
        Exit Sub
    Case Else
        For B = LBound(a) To UBound(a)
        Workbooks.Open a(B)
    Next
End Select
Set CS = ActiveWorkbook 'définit le classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source OS
'définit la cellule de destination DEST (B1 si C1 est vide, sinon la première cellule vide de la colonne B) de l'onglet OD
Set DEST = IIf(OD.Range("B1").Value = "", OD.Range("B1"), OD.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0))
Debug.Print DEST.Address(0, 0)
OS.Range("C6:X" & OS.Cells(Application.Rows.Count, 24).End(xlUp).Row).Copy 'copie les données de l'onglet source
DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs dans DEST
Application.DisplayAlerts = False 'masque les message d'Excel (trop de données dans le presse-papier)
CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
Application.DisplayAlerts = True 'affiche les messages d'Excel
OD.Range("B:X").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Header:=xlNo 'supprime les doublons
CD.Sheets("Interface utilisateur").Activate 'active l'onglet "Interface utilisateur"
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub

Le 29/04/2015 à 13:17

Merci et désolé pour la perte de temps, je comptais pouvoir bidouiller par moi même à partir d'un modèle mais je n'y suis pas parvenu.

Merci à tous.

Rechercher des sujets similaires à "importer donnees feuilles"