Code vba comparer F1 et F2 et copier/coller en F2

Regueiro

XLDnaute Impliqué
Bonsoir le Forum
Dans mon code ci-dessous que j'ai repris sur le site de Boisgontier.
Je compare entre les 2 feuilles et copie dans la feuille2
J'aimerais l'adapter pour copier/coller les données sur 3 colonnes.
Mais je bloque.
Code:
Sub MajTph()
Set f1 = Sheets("0.Récap")
Set f2 = Sheets("0.Prix Unitaires")
Set d1 = CreateObject("Scripting.Dictionary")
For Each C In f2.[E8:G36]
    If C.Text <> "" Then
        d1(C.Text) = ""
    End If
Next C
Set d2 = CreateObject("Scripting.Dictionary")
For Each C In f1.[E8:G36]
    If C.Text <> "" Then
        If Not d1.exists(C.Text) Then
            d2(C.Text) = ""
        End If
    End If
Next C
If d2.Count > 0 Then
    f2.[E8].End(xlUp).Offset(1).Resize(d2.Count, 1) = Application.Transpose(d2.Keys) 'Ok marche mais transpose
 End If
End Sub
Merci de votre Aide.
A+
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonsoir le Forum
Bonsoir David84
Sur mon post précédent j'ai essayé de résumé mes besoins.
Je ne se sais si c'est clair pour toi.
Ou bien aurais-tu una autre solution.
Actuellement je bloque sur la façon de pouvoir gérer mes prix unitaires.
Merci.
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonjour,
Avant tout, ce serait bien que tu répondes aux questions que je t'avais posées dans mes messages précédents et auxquelles je n'ai toujours pas de réponse.

Concernant la question du tri des données de la feuille prix unitaires, pas besoin d'utiliser la macro dont tu me parles : passer par un Sort est bien plus simple :
Code:
Sub BD1_BD2()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set f1 = Sheets("0.Récap")
  Set f2 = Sheets("0.Prix Unitaires")
  a = f1.Range("E8:G36")
  DerLig = f2.Range("E" & f2.Rows.Count).End(xlUp).Row
  b = f2.Range("E8:G" & DerLig)
  Set mondico1 = CreateObject("Scripting.Dictionary")
  For I = 1 To UBound(b)
    For j = 1 To UBound(b, 2): temp = temp & b(I, j): Next j
    mondico1(temp) = ""
    temp = ""
  Next I
  ligne = 1
  Dim c
  ReDim c(1 To UBound(a), 1 To UBound(a, 2))
  For I = 1 To UBound(a)
        If a(I, 2) <> "" Then
            temp = ""
            For K = 1 To UBound(a, 2): temp = temp & a(I, K): Next K
            If Not mondico1.Exists(temp) Then
                For K = 1 To UBound(a, 2): c(ligne, K) = a(I, K): Next K
                ligne = ligne + 1
            End If
        End If
  Next I
  f2.Range("E" & DerLig + 1).Resize(ligne - 1, UBound(a, 2)) = c
  DerLig = f2.Range("E" & f2.Rows.Count).End(xlUp).Row
  Range("E8:H" & DerLig).Sort key1:=[E8], Order1:=xlAscending, Header:=xlNo 'tri des données
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub
Dans le cas présent, une seule clé est utilisée sur les codes : tu peux modifier ce code en ajoutant une 2ème voire une 3ème clé de tri (cf. l'aide d'Excel sur la méthode Sort).

Concernant l'organisation de ton fichier, si je comprends bien tu n'as créé cette feuille prix unitaire uniquement parce que tu utilisais des formules dans la feuille recap et que donc tes données n'étaient pas modifiables.
Tu connais mieux la finalité de ton fichier que moi mais il me semble qui tu y es pris à l'envers : actuellement, tu cherches à faire en sorte que lorsque tu modifies un prix un dans une feuille ART ou lorsque tu rentes un nouvel article, les modification doivent être opérées dans recap et prix unitaire.
Et comme en plus tu utilise des formules, pas moyen de modifier les données de prix unitaire et donc ...tu crées une autre feuille.

Je pense a priori que tu aurais dû faire l'inverse :
- créer une feuille dans laquelle tu rentres tous les codes, désignation, Un, prix (appelée "recap" par exemple)
- ensuite, à l'aide d'un USF que tu peux ouvrir sur n'importe quelle feuille ART, tu as à ta disposition toutes ces lignes (voir même simplement une liste déroulante avec le code si la désignation, l'Un et le prix sont directement liés au code) et tu peux choisir les infos que tu veux.
- lorsque tu veux modifier un renseignement (code, désignation,l'Un, le prix, ...), tu le modifies dans la feuille recap et cette modification est actualisée dans toutes les feuilles ART.
Mais bon, si tu as fait comme cela c'est sûrement que tu as tes raisons et que je ne les saisis pas.
A+
 
Dernière édition:

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonjour le Forum
Bonjour David.
J'ai vu en vitesse ton message.
Je te remercie d'avance.
Je regarde cela attentivement ce soir.
Merci encore de te pencher sur mon problème.
Concernant l'organisation de mon fichier :
Je crois que tu viens de me donner une très bonne solution.
J'étudie ta proposition.
A+
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonsoir à tous.
Bonsoir David84

Voilà j'ai trouver bon bonheur.
Grâce à toi, merci beaucoup.
Explication :
Feuille 0.Prix unitaires.
Ici je gère mes différents prix unitaires.
Colonnes E8:G8 j'introduis les nouveaux articles.
Colonne H8, le prix unitaire de l'article.
Ensuite en colonne I8 un taux pour les frais Généraux s'applique à mon prix unitaire
en fonction de mes choix fait en Q8:T16
Ainsi en colonne J8 j'ai le prix de vente avec lequel je peux travailler.

Feuille ART.001
Double-click en B21 par exemple un USF s'ouvre.
Tu choisis ton article.

Pour ton info:
La feuille 0.Récap me sert de récapitulation financière pour l'offre.
Par exemple :
Tu vas en Feuille 0. Soumission.
Art. 001 Isolation 200 mm
Art. 002 Isolation 180 mm. ( variante non additionnée )
Tu clic sur le bouton rouge création des onglets.
Il me crée des nouvelles feuilles.
Sur ces 2 nouvelles je calcule les prix voir exemple.
Sur ma Feuille 0. Récap je ne prends pas en compte la Feuille 0.ART.002 vu que c'est
une variante non additionnée.
voilà pour les explications.

Par contre j'ai un petit problème à régler
Ma feuille ART.0_Base me sert de modèle pour créer les nouvelles feuilles.
Elle sera donc protégée et l'utilisateur aura accès à certaines cellules uniquement.

Quand je crée mes onglets il prend les valeurs selon la macro.
Si ma feuille est protégé j'ai dit de la déprotéger et de la reprotéger.
Mais en Cellule E8 (Verrouillée ) prend la valeur de la feuille 0.soumission E8.
Ainsi la nouvelle créer se nomme selon cette cellule.
Alors là j'ai un bug.

2. j'ai créer un module6
Constante public pour gérer les mots de passe.

Voilà je te joins le fichier.

Merci encore
A+
 

Pièces jointes

  • Prog Devis V37 sans USF.xlsm
    234.4 KB · Affichages: 67

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
Pour l'instant, ne t'occupe pas de protéger et déprotéger ta feuille : crée ta macro en créant un nouvel onglet en recopiant ta feuille ART.0_base dans cette feuille vierge et en lui apportant les modifications désirées et montre-moi le code.
Si tu bloques, explique ce qui te pose problème et la partie code que tu as essayée.
Une fois que cela sera réglé tu pourras t'occuper de la protection/déprotection de la feuille.
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
non, pas de problème à l'ouverture.
Tu dis
Alors là j'ai un bug.
mais quel bug ? Si je rentre en E10 de 0.soumission "003" et que je lance le code il me créé un nouvel onglet ART.003 donc je ne comprends pas où est le bug.
Sois plus précis STP parce que là je ne te comprends pas.
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
Chez moi les nouvelles créer on un bug ?
Encore une nouvelle fois, sois plus précis ! Me dire qu'elles ont un bug ne m'avance pas plus.
Qu'ont-elles exactement qui ne te convienne pas ?
La seule chose que je vois c'est que
ActiveSheet.Unprotect "PWd"
déprotège la feuille active qui est 0.soumission et que
ActiveSheet.protect "PWd"
protège la feuille active qui est à ce moment-là ART.xxx. Lance ta macro en pas à pas et tu t'en rendras compte.
Si tu veux reprotéger la feuille 0.soumission, utilise le nom de la feuille à la place de ActiveSheet :
Sheets("0.Soumission").Protect "PWd"
Mais à part cela quel est exactement le problème ?
A+
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
Le Bug est dans la nouvelle que tu crée, elle se nomme selon la cellule E8

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  ActiveSheet.Name = Range("$E$8").Text
End Sub

Chez moi avec Feuille 0.Récap Protégée, je crée nouvelle feuille
Dans mes nouvelles en E8 j'ai "ART.0_Base".
Mes 2 feuilles se nomment bien ART.001 et ART.002. ??
Dès que click sur une des 2 feuilles.

Message :
Erreur d'exécution '1004'
Impossible de renommer un feuille comme une autre feuille,
bibliothèque d'objets référencée ou un classeur référence par Visual Basic

Comprends tu le problèmes que j'ai.
En fait vu que le classeur est protégée et la cellule E8 Verrouillée
je crois que c'est ça qui me crée problème.
Merci
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
Désolé mais je n'arrive pas à reproduire le bug : je créé une nouvelle feuille (ART.003).
En cellule E8 j'ai ART.003.
Si dans cette feuille créée je double clique en E21 cela plante parce que le USF1 n'est pas disponible dans ton fichier, mais à par cela je ne vois pas...explique moi ce que je dois faire pas à pas pour reproduire ton bug ?
A+
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
Tu dois au préalable protéger la feuille ART.0_BASE
Ensuite tu créer un nouvel Article sur la feuille 0.Soumission
Par exemple E10 = 004 / F10 = Béton / G10 = m3 / H10 = 34
Bouton rouge Création Onglets.

Ensuite tu vas sur la nouvelle feuille créer ART.004
Normalement les données E10 - F10 - G10 - H10
Sont identiques à celles créer précédemment.
Le nom de feuille = E8 = ART.004

USF2 est accessible double-Click B19:B39 colonne Rouge
Alors là le message d'erreur doit apparaître.
Merci encore.
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonjour,

Alors déjà, concernant la protection et la déprotection de la feuille 0.soumission, je t'ai déjà expliqué ce qu'il fallait faire dans mon message #39, donc fais-le.

Concernant ton problème, place entre Next mycell et Application.ScreenUpdating = True
Code:
  Sheets(newSheetName).Unprotect "PWd"
  Range("E8").Value = newSheetName
  Sheets(newSheetName).Protect "PWd"
et là cela fonctionne chez moi.

De manière plus générale si tu veux progresser dans la compréhension des macro et comprendre pourquoi un code ne donne pas le résultat attendu, il te faut absolument savoir comment faire fonctionner ton code en mode pas à pas :
- placer un point d'arrêt au début du code (ou avant l'endroit ou il plante s'il y a bug)
- appuyer sur F8 pour faire progresser le code d'une étape
et là tu peux suivre la progression du code et plus facilement voir là où cela dysfonctionne.
Tant que tu ne sais pas faire cela, tu pourras passer des heures sur un code sans comprendre pourquoi il ne fonctionne pas correctement.

Si tu l'avais fait, tu te serais aperçu que CONSO 3D est appelée à chaque fois : si elle ne te sert plus à rien vire-là, sinon, je t'ai déjà expliqué comment faire pour ne pas que cela arrive, donc fais-le.

Si tu as encore un problème, place un nouveau fichier comportant les modifications apportées et épuré de tous les codes et formules qui ne sont plus utiles.
A+
 
Dernière édition:

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonjour à Tous.
Bonjour David84 merci pour tes précieux, conseils.
Je te joint mon nouveau ficier avec les modifs apportées.

Mais dans mon fichier j'ais toujours mon problème.
Je ne sais pas si c'est uniquement chez Moi ?
Regarde
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Pardon Fausse Manip.

Bonjour à Tous.
Bonjour David84 merci pour tes précieux, conseils.
Je te joint mon nouveau ficier avec les modifs apportées.

Mais dans mon fichier j'ais toujours mon problème.
Je ne sais pas si c'est uniquement chez Moi ?
Regarde
Feuille ART.001 = E8 = ART.0_BASE ??? si tu vas sur cette feuillle Message erreur
Feuille ART.002 = E8 = ART.0_BASE ??? si tu vas sur cette Feuille Message erreur
Feuille ART.003 = E8 = ART.ART.003 ???

Concernant la touche F8
Je ne connais pas trop.
Aurais-tu une aide ou Vidéo exemple pour m'éclairer sur cette touche magique.
Ou vois-tu la progression du code et ou vois-tu que CONSOD 3D est appelée
 

Pièces jointes

  • Prog Devis V50 sans USF.xlsm
    257 KB · Affichages: 54
  • Prog Devis V50 sans USF.xlsm
    257 KB · Affichages: 44
  • Prog Devis V50 sans USF.xlsm
    257 KB · Affichages: 53

Discussions similaires

Réponses
1
Affichages
170