Problème .xlt

Salut à tous,

J'ai un modèle (ci-joint) qui insère 5 feuilles, puis grâce à un bouton, j'importe les données du fichier sélectionné, en les filtrants etc..

Voici le code qui m'intéresse :

Sub Copie(x As String)
    Dim NewBook As Workbook, tablo1, I&, tablo2(), tablo3(), tablo4(), n&, m&, o&
    Set NewBook = Workbooks(x)
    tablo1 = NewBook.Sheets("EXPORT TOPSOLID").Range("A1").CurrentRegion
    For I = 2 To UBound(tablo1)
        Select Case tablo1(I, 24)
            Case "MASSIF"
                ReDim Preserve tablo2(n)
                tablo2(n) = WorksheetFunction.Index(tablo1, I, 0)
                n = n + 1
            Case "PANNEAUX", "PLEXI", "STRAT"
                ReDim Preserve tablo3(m)
                tablo3(m) = WorksheetFunction.Index(tablo1, I, 0)
                m = m + 1
            Case "PROFIL", "QUINCAILLERIE"
                ReDim Preserve tablo4(o)
                tablo4(o) = WorksheetFunction.Index(tablo1, I, 0)
                o = o + 1
        End Select
    Next I
    With ThisWorkbook.Sheets("LISTING M.").Range("R10")
        .CurrentRegion.Offset(1).ClearContents
        If n > 0 Then .Resize(n, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo2))
    End With
    With ThisWorkbook.Sheets("LISTING P.").Range("S10")
        .CurrentRegion.Offset(1).ClearContents
        If m > 0 Then .Resize(m, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo3))
    End With
    With ThisWorkbook.Sheets("LISTING QUINC").Range("N13")
        .CurrentRegion.Offset(1).ClearContents
        If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo4))
    End With
    NewBook.Close False
End Sub
Sub i1()  'Insérer lignes si matière <>
  Dim c As Long
  Dim LastRow As Long
  ' Penser à instancier l'objet conteneur avec With
  ' Comme VBA sait ou il doit travailler
  With ThisWorkbook.Sheets("DEBIT M.")
    ' Dernière ligne
    LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
    ' Pour chaque ligne
    For c = LastRow To 12 Step -1
      If .Range("H" & c).Value <> "" And .Range("H" & c).Offset(-1, 0).Value <> "" Then
        If .Range("H" & c).Value <> .Range("H" & c).Offset(-1, 0).Value Then
          .Range("H" & c).EntireRow.Insert Shift:=xlDown
        End If
      End If
    Next
  End With
End Sub[/code

On copie les données vers les feuilles, de façon bien spécifique tout en les filtrants.
Le problème, c'est que, si j'insère DEUX fois ce même modèle, sa me créer des feuilles avec un (2) (sa c'est pas un soucis, et je vais de toute façon renommer ce "(2)" de façon différente à chaque fois), lorsque j'importe mes données, ils vont toujours dans les premières feuilles insérer.

Normal, puisque dans mon code, on indique vers quel feuille collées les données :

[code]With ThisWorkbook.Sheets("LISTING M.").Range("R10")

J'aimerais que lorsque j'importe, à partir du bouton qui se trouve dans "DEBIT M.", sa colle les données dans les feuilles "LISTING M", "LISTING P." et "LISTING QUINC.", et lorsque j'importe à partir du bouton qui se trouve dans "DEBIT M. (...)", sa colle les données dans les feuilles "LISTING M(...)", "LISTING P(...)" etc.. et non toujours vers la première.

Fichier en .xlsm, pour pouvoir le joindre au message, sinon c'est un .xlt.

6modele-import1.xlsm (222.51 Ko)

Bonsoir

Tu crées une seule et même procédure.

Tu boucles sur toutes tes feuilles excel ( For each Sheets ... )

Du coup tu lui dis if sheets different de ActiveSheet.Name ( celle a partir de laquelle tu as lancé la macro ) il va t importer les autres feuillets sauf celle ou tu es

et cela marchera sur toutes et en n'ayant qu'une seule et meme procedure

Un peu dans ce style

Sub test()

Dim Feuille As Worksheet
Dim Feuille_appel_macro As Worksheet
Set Feuille_appel_macro = ActiveWorkbook.ActiveSheet

For Each Feuille In ActiveWorkbook.Worksheets

        If Feuille_appel_macro.Name <> Feuille.Name Then

             With ThisWorkbook.Sheets(Feuille.Name).Range("R10")
                .CurrentRegion.Offset(1).ClearContents
                    If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
                    WorksheetFunction.Transpose(tablo4))
            End With

             With ThisWorkbook.Sheets(Feuille.Name).Range("S10")
                .CurrentRegion.Offset(1).ClearContents
                    If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
                    WorksheetFunction.Transpose(tablo4))
            End With

            With ThisWorkbook.Sheets(Feuille.Name).Range("N13")
                .CurrentRegion.Offset(1).ClearContents
                    If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
                    WorksheetFunction.Transpose(tablo4))
            End With

        NewBook.Close False
        End If

Next

End Sub

Cdt

Salut à toi, alors j'ai essayer d'utiliser ton code sans succès, celui-ci s'arrête car il ne reconnait pas "Feuille.Name".

Après je suis que débutant, alors j'ai peut-être mal procédé ?

Ce que je ne comprend pas, c'est qu'on met :

With ThisWorkbook.Sheets(Feuille.Name).Range("R10")

Comment peut-il collées les données dans 3 feuilles différentes ? (LISTING M. ; LISTING P. ; LISTING QUINC.) avec toujours la même variable ?

J'insère une première fois le modèle (DEBIT M. ; LISTING M. ; ETIQUETTE ; LISTING P. ; LISTING QUINC.) et j'importe les données vers ces feuilles grâce à la feuille "DEBIT M.". Si j'insère une deuxième fois, alors j'aurais "DEBIT M.(2) ; LISTING M(2). ; ETIQUETTE(2) ; LISTING P(2). ; LISTING QUINC.(2)" et cette fois ci j'importerais les données depuis "DEBIT M.(2)"

Cordialement

Bonjour

En fait le for each feuille va balayer toutes les feuilles

Dans votre cas listing m listing p et listing quinc

Cette methode evite d avoir a repeter le code

Le controle que je fais est de dire

Je liste les feuilles

Il ouvre listing m

Si listing m n est pas la feuille depuis laquelle la macro est appelle alors il fait les actions

Au lieu d ecrire thisworkbook.sheets("listing m") on recupere listing m depuis le nom feuille puisqu on balaye toutes les feuilles

Cdt

Salut, ok pour l'idée, merci d'avoir prit le temps d'expliquer.

En revanche, je n'arrive pas à imbriquer les codes, j'ai fait sa :

Sub Copie(x As String)

    Dim NewBook As Workbook, tablo1, I&, tablo2(), tablo3(), tablo4(), n&, m&, o&
    Set NewBook = Workbooks(x)
    tablo1 = NewBook.Sheets("EXPORT TOPSOLID").Range("A1").CurrentRegion
    For I = 2 To UBound(tablo1)
        Select Case tablo1(I, 24)
            Case "MASSIF"
                ReDim Preserve tablo2(n)
                tablo2(n) = WorksheetFunction.Index(tablo1, I, 0)
                n = n + 1
            Case "PANNEAUX", "PLEXI", "STRAT"
                ReDim Preserve tablo3(m)
                tablo3(m) = WorksheetFunction.Index(tablo1, I, 0)
                m = m + 1
            Case "PROFIL", "QUINCAILLERIE"
                ReDim Preserve tablo4(o)
                tablo4(o) = WorksheetFunction.Index(tablo1, I, 0)
                o = o + 1
        End Select
    Next I

Dim Feuille As Worksheet
Dim Feuille_appel_macro As Worksheet
Set Feuille_appel_macro = ActiveWorkbook.ActiveSheet

For Each Feuille In ActiveWorkbook.Worksheets

        If Feuille_appel_macro.Name <> Feuille.Name Then

             With ThisWorkbook.Sheets(Feuille.Name).Range("R10")
                .CurrentRegion.Offset(1).ClearContents
                    If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
                    WorksheetFunction.Transpose(tablo4))
            End With

             With ThisWorkbook.Sheets(Feuille.Name).Range("S10")
                .CurrentRegion.Offset(1).ClearContents
                    If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
                    WorksheetFunction.Transpose(tablo4))
            End With

            With ThisWorkbook.Sheets(Feuille.Name).Range("N13")
                .CurrentRegion.Offset(1).ClearContents
                    If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
                    WorksheetFunction.Transpose(tablo4))
            End With

        NewBook.Close False
        End If

Next

End Sub

Mais sa pose problème, ici :

With ThisWorkbook.Sheets(Feuille.Name).Range("R10")

Cordialement

Pourriez vous essayer sheets(feuille) et non feuille.name

Salut, pas mieux on dirait, sa me met exactement la même erreur.

Mais peut-être que j'ai mal manipuler le code.

J'ai remplacer mon code, par le tiens.

Sans rien faire d'autre de plus, peut-être qu'il me manque une manip de ma part ?

Si tu souhaite tester ton code, tu as mon fichier dans mon tout premier message, merci à toi !

Cordialement

Peux tu poster le fichier avec les modifs je vais y jetter un oeil

Cdt

Très bien, les voici :

Le fichier "RECUP_TS[..]" étant le .xlt (mais pour pouvoir l'insérer dans le forum je devais le mettre en .xlsm) et "LISTING PANNEAUX[..]" étant le fichier à importer.

Cordialement

ok j ai compris plus exactement ta problématique.

Dès le début de macro quand tu appelles tes fonctions il faut garder en mémoire depuis quelle feuille tu appelles la macro et il faut envoyer ce nom de feuille aux fonctions :

Public Sub CommandButton1_Click()
Dim Feuille_appel_macro As Worksheet
Set Feuille_appel_macro = ActiveWorkbook.ActiveSheet
Feuille_appel_macro_name = Feuille_appel_macro.Name
Call SelectFichier
i1 Feuille_appel_macro_name
i2 Feuille_appel_macro_name
i3 Feuille_appel_macro_name
t1 Feuille_appel_macro_name
t2 Feuille_appel_macro_name
End Sub

Pour utiliser ces variables vers les fonctions pense à nommer tes "sub" => "Public sub" plutôt pour que l echange de variable fonctionne

Ensuite si dans ton code tu fais du coller vers tes feuilles il suffit de faire le test suivant exemple

ThisWorkbook.Sheets("LISTING P.").Activate
    If ActiveSheet.Name <> Feuille_appel_macro_name Then
    With ThisWorkbook.Sheets("LISTING P.").Range("S10")
        .CurrentRegion.Offset(1).ClearContents
        If m > 0 Then .Resize(m, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo3))
    End With
    End If  

Activate sert a activer la feuille ou tu vas coller

Ensuite on regarde si la feuille ou l on veut coller soit egale ou non a la feuille ou on a appelé la macro

Si egale on ne fait rien

Sinon il fera ce que tu as codé

Est ce clair ?

Cdt,

Salut à toi, alors j'ai bien compris la première et seconde partie de ton message, en revanche pour la troisième partie c'est clair, mais je ne sais ce qu'il faut supprimer (par rapport à tes précédents messages) et/ou mettre ton code à partir de :

Public Sub Copie(x As String)

    Dim NewBook As Workbook, tablo1, I&, tablo2(), tablo3(), tablo4(), n&, m&, o&
    Set NewBook = Workbooks(x)
    tablo1 = NewBook.Sheets("EXPORT TOPSOLID").Range("A1").CurrentRegion
    For I = 2 To UBound(tablo1)
        Select Case tablo1(I, 24)
            Case "MASSIF"
                ReDim Preserve tablo2(n)
                tablo2(n) = WorksheetFunction.Index(tablo1, I, 0)
                n = n + 1
            Case "PANNEAUX", "PLEXI", "STRAT"
                ReDim Preserve tablo3(m)
                tablo3(m) = WorksheetFunction.Index(tablo1, I, 0)
                m = m + 1
            Case "PROFIL", "QUINCAILLERIE"
                ReDim Preserve tablo4(o)
                tablo4(o) = WorksheetFunction.Index(tablo1, I, 0)
                o = o + 1
        End Select
    Next I

Dim Feuille As Worksheet
Dim Feuille_appel_macro As Worksheet
Set Feuille_appel_macro = ActiveWorkbook.ActiveSheet

For Each Feuille In ActiveWorkbook.Worksheets

        If Feuille_appel_macro.Name <> Feuille.Name Then

ThisWorkbook.Sheets("LISTING M.").Activate
    If ActiveSheet.Name <> Feuille_appel_macro_name Then
    With ThisWorkbook.Sheets("LISTING M.").Range("S10")
        .CurrentRegion.Offset(1).ClearContents
        If m > 0 Then .Resize(m, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo2))
    End With
    End If
ThisWorkbook.Sheets("LISTING P.").Activate
    If ActiveSheet.Name <> Feuille_appel_macro_name Then
    With ThisWorkbook.Sheets("LISTING P.").Range("S10")
        .CurrentRegion.Offset(1).ClearContents
        If n > 0 Then .Resize(n, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo3))
    End With
    End If
ThisWorkbook.Sheets("LISTING QUINC.").Activate
    If ActiveSheet.Name <> Feuille_appel_macro_name Then
    With ThisWorkbook.Sheets("LISTING QUINC.").Range("S10")
        .CurrentRegion.Offset(1).ClearContents
        If o > 0 Then .Resize(o, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo4))
    End With
    End If

        NewBook.Close False
        End If

Next

End Sub

Merci à toi pour tes explications, et d'avoir prit le temps.

Cordialement

Par rapport à ton code, j'ai une erreur dès le début :

181007011216443389

Pour moi repars de ton fichier original.

Ajoute le bout qui corrige l'appel des fonctions

Ensuite balaye dans l ordre tes fonctions pour intercepter la ou la modification de doit pas être appliquée

Dans le cas ou ta feuille origine = feuille qui va être modifiée

C est vraiment ça l'idee

N'hésite pas à poster si tu bloques vraiment

Cdt,

sur le début de procédure i1 ( pas l appel mais la fonction en elle même ) l'as tu modifiée ?

Public Sub i1(Feuille_appel_macro_name)

cdt,

Salut à toi,

Deux problèmes :

1) Dès le premier import, mes sub(s) "t1" et "t2" m'affichent une erreur.

2) Lors de l'import du modèle pour la seconde fois, sa bug dès le départ.

J'ai mis fais une vidéo, pour montrer les manip :

https://www.youtube.com/watch?v=diiMXk-yN5w

Cordialement

Comme ca en regardant

je dirais que tes problemes sur les fonction T , c est qu'il faut mettre avant la premiere ligne Range.... .select

Il faut remettre la feuille en active sheet je pense

Sheets("NOMFEUILLE").activate

pour ton deuxieme cas ta feuille se nomme debit m (2 )

toi tu filtres en dur dans tes procedures le nom debit M et le M(2) n est pas dedans

Envoie moi le fichier si tu veux pour confirmer

cdt,

Salut à toi,

Voici le fichier brut, comprenant les deux soucis indiqués dans mon précédent message.

Cordialement

voila le fichier

il fallait preciser les fichiers dans les T% avc activate + preciser dans les select quel sheets prendre

De plus le fichier Quinc contient un . et dans le code vous l'aviez oublié

Salut,

On progresse, ça marche parfaitement pour le premier import, mais pour le second, j'ai une nouvelle fois un problème :

181007030636536039

Je ne sais quoi dire, ça marche dépasse..

Comment s appelle l onglet que vous avez cree a partir du modele ds un second temps?

Rechercher des sujets similaires à "probleme xlt"