importation de plusieurs fichiers sur plusieurs feuilles

Question

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

f894009 · Answer

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+

klissou69 · Answer

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 ?

f894009 · Answer

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+

klissou69 · Answer

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

f894009 · Answer

Re,

mettre:
Call extract apres le next x dans sub test1

A+

klissou69 · Answer

Non cela ne fonctionne toujours pas, même en rajoutant :


[...]
    Next x
    Call extract

f894009 · Answer

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

klissou69 · Answer

toujours le même message d'erreur !!

"erreur 1004" et le .Refresh en jaune

f894009 · Answer

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+

klissou69 · Answer

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"

f894009 · Answer

Re,

Je ne vois pas du tout!!!!!!!

Quelle erreur avez-vous ??????????????????????

klissou69 · Answer

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'

f894009 · Answer

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+

klissou69 · Answer

Je vous remercie cela fonctionne !!

Merci pour votre implication et votre aide.

Sincèrement

klissou69 · Answer

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.

f894009 · Answer

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

klissou69 · Answer

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.

f894009 · Answer

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+

f894009 · Answer

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+

Importation de plusieurs fichiers sur plusieurs feuilles

19 réponses

Discussions similaires

Newsletters