Importation de plusieurs fichiers sur plusieurs feuilles

klissou69 -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention - 27 août 2013 à 17:07

Bonjour,

Je dispose d'un fichier Excel composé de 3 onglets.

Un onglet Accueil, un onglet 1 et un onglet 2

Je souhaite mettre un bouton sur l'onglet Accueil, qui me permette d'importer un fichier dans l'onglet 1 et un autre fichier dans l'onglet 2.

J'ai le code suivant :

Sub Test1()
    Dim Fichier As String, Chemin As String
    Dim i As Long
    
    'Répertoire contenant les fichiers
    'Chemin = "H:\REPERTOIRE"
    Chemin = Worksheets("Chemin").Range("B4")
    Fichier = Dir(Chemin & "\*.*")
    
    'Boucle sur les fichiers
    Do While Fichier <> ""
        
        i = Range("A65536").End(xlUp).Row + 1
        ImportText1 Chemin & "\" & Fichier, Cells(i, 1)
        
        Fichier = Dir
    Loop
End Sub
 


Sub ImportText1(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable
    
    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Cible)
    
    With QT
        'Définit les séparateur de colonnes dans le fichier txt
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
End Sub

Ce code fonctionne si mon bouton est directement sur mon onglet.

Comment modifier ce code pour pouvoir importer 2 fichiers de 2 repertoire différents dans 2 onglets différentes à partir de l'onglet Accueil ?

J'espere avoir été suffisamment clair.

Merci d'avance

Excel 2003

Afficher la suite

A voir également:

Importation de plusieurs fichiers sur plusieurs feuilles
Renommer plusieurs fichiers en même temps - Guide
Votre appareil ne dispose pas des correctifs de qualité et de sécurité importants - Guide
Comment faire un livret avec des feuilles a4 - Guide
Regrouper plusieurs feuilles excel en une seule - Guide
Explorateur de fichiers - Guide

19 réponses

Réponse 1 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Bouton sur Accueil

Sub Test1()
    Dim Fichier As String, Chemin As String
    Dim i As Long, Onglet(2)
    
    'onglet
    Onglet(1) = "Feuil2"
    Onglet(2) = "Feuil3"
    'Répertoire contenant les fichiers
    'Chemin = "H:\REPERTOIRE"
    For x = 1 To 2
        Chemin = Worksheets("Chemin").Range("B" & 3 + x)
        Fichier = Dir(Chemin & "\*.*")
    
        'un fichier
        If Fichier <> "" Then
        'Boucle sur les fichiers
            i = Worksheets(Onglet(x)).Range("A65536").End(xlUp).Row + 1
            Cible = "A" & i
            ImportText1 Chemin & "\" & Fichier, Onglet(x), Cible
            Fichier = Dir
        End If
    Next x
End Sub
 
Sub ImportText1(NomFichier As Variant, Onglet, Cible)
    Dim QT As QueryTable
    
    Set QT = Worksheets(Onglet).QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Worksheets(Onglet).Range(Cible))
    
    With QT
        'Définit les séparateurs de colonnes dans le fichier txt
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
End Sub

A voir

A+

Réponse 2 / 19

klissou69

Salut f894009 et merci à toi pour ton aide, une nouvelle fois ;)
Ton code marche très bien, mais quand je rajoute un petit bout de code, qui marche séparément aussi, cela ne marche plus et me met une erreur sur le ".Refresh".

Sub TestAccueil()
    Dim Fichier As String, Chemin As String
    Dim i As Long, Onglet(2)
    
    'onglet
    Onglet(1) = "MT535"
    Onglet(2) = "PRIX"
    'Répertoire contenant les fichiers
    'Chemin = "H:\REPERTOIRE"
    For x = 1 To 2
        Chemin = Worksheets("Chemin").Range("B" & 3 + x)
        Fichier = Dir(Chemin & "\*.*")
    
        'un fichier
        If Fichier <> "" Then
        'Boucle sur les fichiers
            i = Worksheets(Onglet(x)).Range("A65536").End(xlUp).Row + 1
            Cible = "A" & i
            ImportText1 Chemin & "\" & Fichier, Onglet(x), Cible
            Fichier = Dir
        End If
    Next x
End Sub
 
Sub ImportText1(NomFichier As Variant, Onglet, Cible)
    Dim QT As QueryTable
    
    
    Set QT = Worksheets(Onglet).QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Worksheets(Onglet).Range(Cible))
    
    With QT
        'Définit les séparateurs de colonnes dans le fichier txt
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
    
    

    
End Sub

Sub extract()
Dim k As Double 'initialisation des variables
    k = 2
    Dim l As Double
    l = 2
    Dim m As Double
    m = 2
    
    
    nbligne1 = Sheets("MT535").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To nbligne1 'boucle qui va nous faire parcourir toutes les lignes de la feuille1

        If Left(Cells(i, 1).Value, 5) = ":35B:" Then 'Si le début de la cellule contient ":35B:"
            Sheets("Traitement").Cells(k, 1).Value = Sheets("MT535").Cells(i, 1).Value 'Alors on copie la ligne
            k = k + 1
        ElseIf Left(Cells(i, 1).Value, 5) = ":19A:" Then
            Sheets("Traitement").Cells(l, 3).Value = Sheets("MT535").Cells(i, 1).Value
            l = l + 1
        ElseIf Left(Cells(i, 1).Value, 10) = ":93B::AVAI" Then
            Sheets("Traitement").Cells(m, 5).Value = Sheets("MT535").Cells(i, 1).Value
            m = m + 1
        End If
    Next
End Sub

Saurais-tu pourquoi ?

Réponse 3 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Non, je ne vois pas, car je n'ai pas votre fichier.

Comment est appele le Sub extract() et ou est-il place ????

A+

Réponse 4 / 19

klissou69

J'aimerai qu'il soit déclenché en appuyant sur le même bouton que le reste, et il extrait les infos de l'onglet MT535 pour les mettre dans l'onglet traitement.

Il est placé à la suite des autres sub dans une module

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

Posez votre question

Réponse 5 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

mettre:
Call extract apres le next x dans sub test1

A+

Réponse 6 / 19

klissou69

Non cela ne fonctionne toujours pas, même en rajoutant :

[...]
    Next x
    Call extract

Réponse 7 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

qu'est ce qui ne fonctionne pas ?????????

Réponse 8 / 19

klissou69

toujours le même message d'erreur !!

"erreur 1004" et le .Refresh en jaune

Réponse 9 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

le sub extract n'y est pour rien. Quand vous avez l'erreur, click sur debugage et mettez le curseur souris sur les variables du set QT pour voir leur contenu.

A+

Réponse 10 / 19

klissou69

Il me semblait que le sub extract avait un impact vu que votre code marchait avant que je " colle " le sub extract à cet endroit.

En ce qui concerne les variables il y a :

MT535 dans "onglet"
le bon repertoire d'importation dans "NomFichier"
MT535 dans "onglet"
et A2 dans "cible"

Réponse 11 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Je ne vois pas du tout!!!!!!!

Quelle erreur avez-vous ??????????????????????

Réponse 12 / 19

klissou69

J'ai supprimé et testé de nouveau votre code, je n'ai plus d'erreur, mais le traitement ne se fait plus (comme si le "call extract " n'avait pas lieu, ou que l'opération du sub extract ne s'effectuait pas). Peut être un problème de destination de feuille vu que le bouton est sur la feuille 'Accueil'

Réponse 13 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

dans votre sub extract, vous ne donnez pas l'onglet ou faire les tests cellules:

If Left(Cells(i, 1).Value, 5)----> pour le programme c'est l'onglet actif a ce moment la!!!!!!!

code modifie:

Sub extract()
    Dim k As Double 'initialisation des variables
    k = 2
    Dim l As Double
    l = 2
    Dim m As Double
    m = 2
    
    With Sheets("MT535")
        nbligne1 = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To nbligne1 'boucle qui va nous faire parcourir toutes les lignes de la feuille1

            If Left(.Cells(i, 1).Value, 5) = ":35B:" Then 'Si le début de la cellule contient ":35B:"
                Sheets("Traitement").Cells(k, 1).Value = .Cells(i, 1).Value 'Alors on copie la ligne
                k = k + 1
            ElseIf Left(.Cells(i, 1).Value, 5) = ":19A:" Then
                Sheets("Traitement").Cells(l, 3).Value = .Cells(i, 1).Value
                l = l + 1
            ElseIf Left(.Cells(i, 1).Value, 10) = ":93B::AVAI" Then
                Sheets("Traitement").Cells(m, 5).Value = .Cells(i, 1).Value
                m = m + 1
            End If
        Next i
    End With
End Sub

A+

Réponse 14 / 19

klissou69

Je vous remercie cela fonctionne !!

Merci pour votre implication et votre aide.

Sincèrement

Réponse 15 / 19

klissou69

Excusez-moi d'abuser mais j'ai un autre petit souci lié au problème précédent.

J'essaie de lier un enregistrement de macro à ce bouton sur ma page d'accueil mais cela ne fonctionne pas.

Quand j'enregistre ma macro, je pars de la page d'accueil, je fais mes actions sur un autre onglet et j'arrête l'enregistrement.

Et quand je la lance à partir de mon bouton, elle agit sur la page d'accueil, comme si elle n'avait pas 'compris' que c'était pas sur la même feuille.

J'ai essayé de rajouter with("page2") mais cela ne fonctionne pas.

Réponse 16 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

il faut montrer le code, parce que de but en blanc, c'est moi qui ne comprend pas

A+

Réponse 17 / 19

klissou69

Alors j'ai ce code la qui marchait dans mon onglet "Traitement".

C'est un enregistreur de macro.

Tout d'abord, est-il possible de combiner du code VBA avec une macro Excel ?

Sub MacroMEPAccueil()
'
' MacroMEPAccueil Macro
' Macro enregistrée le 27/08/2013 par VRMO724
'

'
    Sheets("Traitement").Select
    Range("H2:H14").Select
    Selection.Copy
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J2:J14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("K2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L2:L14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J2:J14").Select
    Selection.Find(What:=",", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("K2:K14").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("M2:M14").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

J'essaie de l'intégrer au bouton sur ma page d'accueil pour qu'en un clic, toutes les opérations s'effectuent ( c'est la suite logique de mes questions d'hier ).
Malheureusement, quand je le lance, l'action s'effectue sur la page d'accueil, même si j'intègre un with sheets.("traitement") au début du code.

Réponse 18 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Tout d'abord, est-il possible de combiner du code VBA avec une macro Excel ? Oui, c'est la meme chose: du VBA.

Je ragarde votre affaire.

A+

Réponse 19 / 19

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

sans chercher a optimiser:

Sub MacroMEPAccueil()
'
' MacroMEPAccueil Macro
' Macro enregistrée le 27/08/2013 par VRMO724
    Worksheets("Traitement").Activate
        Range("H2:H14").Select
        Selection.Copy
        Range("I2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                            :=False, Transpose:=False
        Range("J2:J14").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("K2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                            :=False, Transpose:=False
        Range("L2:L14").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("M2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                            :=False, Transpose:=False
        Range("J2:J14").Select
        Selection.Find What:=",", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                                False, SearchFormat:=False
        Range("K2:K14").Select
        Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
                                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                    ReplaceFormat:=False
        Range("M2:M14").Select
        Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
                                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                    ReplaceFormat:=False
End Sub

A+

Discussions similaires

Comment trouver les fichier cachés ?

Chemin Logo du site de la Cité de l'espace

fichier secret

Votre réponse

Discussions similaires