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.
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
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é
Comment s appelle l onglet que vous avez cree a partir du modele ds un second temps?