VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supprimer

mynameisjeff

XLDnaute Nouveau
Bonjour à tous,

Dans le cadre d'un projet professionnel, et suite à un manque d'espace disponible,
j'aimerais créer une macro qui :
1. crée un nouveau classeur "Classeur Test" acceptant les macros et avec 2 onglets "UVCI " et "SUPPORT"
2. copier la page "UVCI " de mon classeur source sur les deux onglets du classeur créé "UVCI " et "SUPPORT"
3. lancer ma macro
4. copier les données "A3:N" & finalrow de mon classeur créé sur la page "UVCI " vers mon classeur source depuis A3
finalrow = Cells(Rows.Count, "C").End(xlUp).Row
5. supprimer le classeur créé
(l'idéal étant que vu qu'il s'agisse d'un classeur temporaire, que celui-ci ne soit pas sauvegardé (à aucun moment) afin d'éviter par la suite une recherche du fichier pour le supprimer)

Je remercie d'avance toute personne pouvant m'aider.
Très cordialement
 

Paritec

XLDnaute Barbatruc
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Bonjour mynameisjeff le forum
elle est ou????
""3. lancer ma macro""
la macro que tu souhaites lancer??
je ne vois pas l'intérêt de créer un fichier pour le détruire!!!
si tu nous mettais ton fichier avec les explications dedans on pourrait peut-être comprendre et te donner la solution sans ton idée de créer et détruire
a+
Papou:)
 

mynameisjeff

XLDnaute Nouveau
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Bonjour,

Merci de ta réponse.
Voici ma macro avec les explications qui vont avec :

Sub ACTUALISERBASE()
Partie en cours d'essai pour créer un classeur et copier les données depuis classeur source
FichierOùCopier = ActiveWorkbook.Name
Application.Workbooks.Add
FichierOùColler = ActiveWorkbook.Name
Workbooks(FichierOùCopier).Activate
Sheets("UVCI ").Select
Sheets("UVCI ").Copy After:=Workbooks(FichierOùColler).Sheets(3)
Workbooks(FicherOùColler).Select
Sheets("UVCI ").Select
ActiveSheet.Name = "SUPPORT"
Sheets("Feuil1").Select
ActiveSheet.Name = "UVCI "
Sheets("UVCI ").Select

Application.ScreenUpdating = False

Workbooks(FichierOùColler).Select
Sheets("UVCI ").Select
Ici, ma macro. Elle supprime les doublons, reconditionne le tableau que je souhaite et met en forme sauf que des données en colonne K sont perdues à cette étape et donc, de ce fait, je crée une sauvegarde avant de la supprimer dans un classeur vierge
ActiveSheet.Range("$A$2:$L$" & Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12), Header:=xlNo

derLn = Range("C" & Rows.Count).End(xlUp).Row
Set tabloCol = Range("C3:C" & derLn)
Set tablo = Range("A3:N" & derLn)
ReDim v(derLn - 2, 14)
I = 0
For Each c In tabloCol
If c.Offset(0, -2).Value = 1 Then

For j = 0 To 13
v(I, j) = Cells(c.Row, 1 + j)
Next j
I = I + 1
End If
Next c
tablo.Select
Selection = v

derLn = Range("C" & Rows.Count).End(xlUp).Row
ReDim w((derLn - 2) * 14, 14)
For I = 0 To derLn - 3
For n = 0 To 13
k = n + 1
Label = Choose(k, 1, 1.2, 2, 2.2, 3, 3.2, 4, 5, 6, 7, 7.5, 8, 9, 10)
For j = 0 To 13
If j = 0 Then
w(I * 14 + n, j) = Label 'v(i, j)
Else
w(I * 14 + n, j) = v(I, j)
End If
Next j
Next n
Next I
Range("A3:N" & (derLn - 2) * 14 + 2) = w

Je complete ma base car des formules textes sont adaptées à chaque label
Sheets("UVCI ").Select
Dim finalrow As Long
finalrow = Cells(Rows.Count, "C").End(xlUp).Row

Application.CutCopyMode = False
Range("J3").Select
ActiveCell.FormulaR1C1 = "='reference lineaire'!R[1]C[-4]"
Range("J3").Select
Selection.AutoFill Destination:=Range("J3:L3"), Type:=xlFillDefault
Range("J3:L3").Select
Selection.AutoFill Destination:=Range("J3:L15"), Type:=xlFillDefault
Range("J3:L15").Select
Selection.AutoFill Destination:=Range("J3:L16"), Type:=xlFillDefault
Range("J3:L16").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=6
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("J3:L" & finalrow), Type:=xlFillCopy
Range("J3:L" & finalrow).Select


J'ai lancé ma macro sur ma page "UVCI " et donc vu que j'ai des données qui ont été effacé dans ma colonne M et N, je les recherche dans ma feuille "SUPPORT" par l'intermédiaire d'un recherchev
finalrow = Range("C1048576").End(xlUp).Row

Workbooks(FichierOùColler).Select
Sheets("SUPPORT").Select
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M3").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-12],RC[-11],RC[-10])"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M" & finalrow)

Workbooks(FichierOùColler).Select
Sheets("UVCI ").Select
Range("O3").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-14],RC[-13],RC[-12])"
Range("O3").Select
Selection.AutoFill Destination:=Range("O3:O" & finalrow)
Range("M3").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[2],SUPPORT!C:C[1],2,FALSE),""ERREUR"")"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M" & finalrow)

Je copie et colle en valeurs afin d'oter les formules
Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("N3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
Range("N3").Select
Selection.AutoFill Destination:=Range("N3:N" & finalrow)

Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Cette partie est fausse (à la base je pensais juste ajouter une feuille mais vu que je n'ai pas les ressources mémoires suffisantes, il me faut créer le nouveau classeur comme décrit au-dessus. Donc cette étape du code est faussée
Sheets("SUPPORT").Select
ActiveWindow.SelectedSheets.Delete

Sheets("UVCI ").Select
Range("O3:O" & finalrow).ClearContents

un essai pour récupérer ma feuille de données "UVCI" de mon classeur créé vers mon classeur source
Workbooks(FichierOùColler).Activate
Sheets("UVCI ").Select
Range("A3:N" & finalrow).Copy
Workbooks(FichierOùCopier).Activate
Sheets("UVCI ").Select
Range("A3").Select
ActiveSheet.Paste

Application.ScreenUpdating = True
Cells(3, 1).Select

End Sub
 

Paritec

XLDnaute Barbatruc
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Bonjour Mynameisjeff le forum
sauf que des données en colonne K sont perdues à cette étape
si tu expliquais pourquoi les données de la colonne K sont perdues??
avec la macro que tu donnes les valeurs de K ne sont pas perdues, alors?
a suivre
a+
Papou:)
 

Paritec

XLDnaute Barbatruc
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Bonjour munameisjeff le forum
ton fichier en retour avec ta macro modifiée, et sans création d'un nouveau classeur, elle devrait faire la même chose que ce que tu voulais faire
a tester
a+
Papou:)
 

Pièces jointes

  • Mynameisjeff V2.xlsm
    101.2 KB · Affichages: 35

mynameisjeff

XLDnaute Nouveau
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Bonjour Paritec,
Merci pour tes réponses.
En fait, la première partie de la macro est bonne à savoir la suppression des doublons, ça c'est parfait.
Par contre, la partie qui suit derLN jusqu'à next i est très bien mais il me manque un seul critère qui fait que cette macro ne me fait pas arriver au résultat souhaité.

Je t'explique comment fonctionne cette partie de la macro :
Si un produit a un label 1.00 alors il va copier la ligne 13 fois en dessous.
Sauf que j'ai oublié d'ajouter un élément. Toute la ligne doit bien être dupliqué mais les lignes K et L sont perdues.
Par exemple si j'ai un label 1.00 en ligne 3.
(j'ai 14 labels différents, 1.00;1.20;2.00;2.20;3.00;3.20;4.00;5.00;6.00;7.00;8.00;9.00;10.00)
Donc en ligne 4 j'aurais eu label 1.20 et ainsi de suite.
Mais cette macro me prend la première ligne et la dupplique 13 fois.
Sauf qu'avant que je ne lance ma macro, j'ai des données en K et L.

Exemple si en label 8, 9 et 10 j'ai une valeur "1" dans la colonne K et que dans les labels 1 à 7 j'ai "0" dans la colonne K
Une fois que je lance ma macro, j'ai mes 14 labels mais cependant mes 14 lignes ont la même valeur en K.

Alors après c'est pour ça que j'ai fait toutes les macros autour de celle-ci pour essayer de récupérer ces valeurs.
J'avais donc pensé à créer un nouveau classeur, ou une nouvelle feuille (qui devra être nommé, disons "TEST").
- si création d'un classeur, copier la feuille actuelle sur 2 feuilles du nouveau classeur, lancer ma macro actuelle sur le nouveau classeur et faire un concatener puis un recherchev et sierreur alors le résultat = 0 (colonne K, les valeurs sont uniquement 0 et 1)
puis copier les résultats dans mon classeur actuelle et supprimer le classeur "TEST" sans sauvegarder
- si création d'une feuille "TEST", copier la feuille actuelle, lancer ma macro, faire un concatener, un recherchev et sierreur alors le résultat = 0 et copier les résultats dans la feuille originale et supprimer la feuille "TEST"

Ou alors, si c'est possible.
Rajouter comme critère à ma macro actuelle (qui va de derLn à next i qui est la macro principale), il faudrait prendre en compte avant de lancer cette partie de la macro que SI j'ai une valeur en K différente de 0 et différente de "" (rien en fait) alors trouver un moyen de conserver ces données sans que la macro ne me prenne que ma ligne de label 1 et me la duplique 13 fois.
La macro est très bien, je souhaite juste rajouter ce critère et si on y arrive alors tout ce qui suit n'a plus lieu d'être.

Merci encore Paritec, et le forum
Très cordialement
 

Paritec

XLDnaute Barbatruc
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Mynameisjeff le forum
ta valeur comprise en K ne se trouve pas ailleurs?? dans reference lineaire???
si c'est pas le cas, pourquoi dans ce cas supprimer les doublons ?? puisque c'est pour être recréé ??
tes explications sont pour toi claire mais pas pour moi
tu auras combien de lignes (à 1000 prêt)dans la feuille UCVI ???
a+
Papou:)
 

Paritec

XLDnaute Barbatruc
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Mynameisjeff le forum
autre question tu parles de label mais c'est pas le cas c'est une valeur, quel est le critère à vérifier pour conserver ou venir réinscrire la valeur en K?? le ""label"" puis la référence puis le produit? si ces trois valeurs sont identiques aux anciennes valeurs de la feuilles avant traitement on récupère la valeur de la colonne k c'est bien cela ????
a+
Papou:)
 

mynameisjeff

XLDnaute Nouveau
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Paritec,

En fait, cette feuille est ma base de données et celle-ci sera complétée de façon mensuelle.
Donc mes valeurs remplies dans ma colonne K ne sont présentes nulle part ailleurs vu qu'elles ont été complétées manuellement et ligne par ligne.
Référence linéaire permet juste de rajouter des valeurs texte par un recherchev dans 3 colonnes J à L.
Car toujours dans le même principe j'ai 14 labels différents et les colonnes A à I sont identiques.
Les colonnes J à L sont uniques à chaque label.

Exemple :
Label 1 colonne J : cochon colonne K : porc colonne L : mange tout
Label 2 colonne J : agneau colonne K : mouton colonne L : mange de l'herbe
C'est pour donner une idée
Et donc au prochain produit, donc 14 lignes plus tard, j'ai à nouveau les même références dans ces colonnes la (J à L)

Mais mes valeurs en K sont uniques et ma macro actuelle copie la première ligne et donc toutes mes valeurs en K existant au préalable dans les labels 1.20 et jusqu'au 10 sont effacées.

La suppression des doublons est essentielle car elle me permet d'éviter d'avoir 2 fois ou plus le même produit donc si j'avais un produit en doublon dans ma base, je gagne 14 lignes sur ma base de données et pour la gestion derrière, c'est essentiel.

Mais la seule suppression des doublons n'est pas le problème.
Ce processus de la macro est très bien.
On supprime les lignes entières répétées.
Exemple :
label 1.00 123456 produit 1 ... colonne K : 1
label 1.00 123456 produit 1 ... colonne K : 1

C'est très bien que le logiciel me supprime la ligne en doublon.


Mon logiciel va me permettre d'ajouter à la fin de ma base de données une seule ligne de produit qui sera répétée 14 fois.

Cordialement
 

mynameisjeff

XLDnaute Nouveau
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Paritec,

Oui c'est ça, il faudrait conserver uniquement les valeurs non nulles et non vides en colonne K, les conserver avant la macro et les recoller après la macro en fonction de :
1. nom du produit (colonne C)
2. code article (colonne B)
3. label (colonne A)

Et s'il y a erreur car la valeur recherché n'a pas de cohérence par rapport à la base, alors la valeur en K est égale à 0.
En effet, ce qui est bien c'est que le programme m'ajoute des lignes si je n'ai pas 14 références de produits avec les 14 labels et sur ma base actuelle il y a quelques produits qui n'ont pas les 14 références. Donc il faudrait intégrer le SIERREUR(...;0)

Et si la conservation a dû se faire dans un autre classeur ou dans une nouvelle feuille alors supprimer la feuille ou le classeur après avoir récupérer les données.

Cordialement
 
Dernière édition:

mynameisjeff

XLDnaute Nouveau
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Paritec,

Je suis désolé mais en fait, je viens de me rendre compte que j'ai fait une erreur.
Au lieu de la colonne K, c'est de la colonne M qu'il s'agit.
S'il y a une valeur présente dans la colonne M.
Le principe reste tout à fait le même.
Est-il possible de modifier la formule ?

Cordialement
 

mynameisjeff

XLDnaute Nouveau
Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp

Re Paritec,

Voici donc la formule finale :

Option Explicit
Dim derLn, tabloCol, tablo, c, ln, i, j, v(), w(), n, label, k

Sub Lancer()
Dim fin&, aa, bb, a&
With Feuil31
aa = .Range("$A$2:$N$" & .Range("C" & Rows.Count).End(xlUp).Row)
.Range("$A$2:$L$" & .Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12), Header:=xlNo
derLn = .Range("C" & Rows.Count).End(xlUp).Row
Set tabloCol = .Range("C3:C" & derLn)
Set tablo = .Range("A3:N" & derLn)
ReDim v(derLn - 2, 14)
i = 0
For Each c In tabloCol
If c.Offset(0, -2).Value = 1 Then
For j = 0 To 13
v(i, j) = .Cells(c.Row, 1 + j)
Next j
i = i + 1
End If
Next c
tablo.Select
Selection = v
derLn = .Range("C" & Rows.Count).End(xlUp).Row
ReDim w((derLn - 2) * 14, 14)
For i = 0 To derLn - 3
For n = 0 To 13
k = n + 1
label = Choose(k, 1, 1.2, 2, 2.2, 3, 3.2, 4, 5, 6, 7, 7.5, 8, 9, 10)
For j = 0 To 13
If j = 0 Then
w(i * 14 + n, j) = label 'v(i, j)
Else
w(i * 14 + n, j) = v(i, j)
End If
Next j
Next n
Next i
.Range("A3:N" & (derLn - 2) * 14 + 2) = w
fin = .Cells(Rows.Count, "C").End(xlUp).Row
.Range("J3:L3").FormulaR1C1 = "='reference lineaire'!R[1]C[-4]"
.Range("J3").AutoFill .Range("J3:J" & fin)
.Range("K3").AutoFill .Range("K3:K" & fin)
.Range("L3").AutoFill .Range("L3:L" & fin)
.Range("N3").FormulaR1C1 = "=RC[-1]*RC[-2]"
.Range("N3").AutoFill .Range("N3:N" & fin)
.Range("N3:N" & fin).Copy
.Range("N3:N" & fin).PasteSpecial Paste:=xlPasteValues
bb = .Range("A3:O" & .Range("C" & Rows.Count).End(3).Row)
For i = 1 To UBound(bb)
For a = 1 To UBound(aa)
If bb(i, 1) = aa(a, 1) And bb(i, 2) = aa(a, 2) And bb(i, 3) = aa(i, 3) Then bb(i, 13) = aa(i, 13) Else bb(i, 13) = 0: Exit For
Next a
Next i
.Range("A3").Resize(UBound(bb), UBound(bb, 2)) = bb
End With

Cells(3, 1).Select
End Sub

En rouge, ce qui ne marche pas si ma référence n'existait pas auparavant.
Comment faire pour que s'il ne trouve pas la référence, me mettre la valeur 0 en colonne M ?

Merci pour votre macro et votre aide.
très cordialement
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 008
Membres
101 864
dernier inscrit
elrecruiter