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

[Regueiro]

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.

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+

 

[david84]

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

Re

Ci-joint ton fichier en retour.
Pour les feuilles ART créées avant la modification du code il te fallait déprotéger la feuille et modifier manuellement le nom en E8 : le bug est dû au fait que 2 onglets ne peuvent pas porter exactement le même nom.
J'ai enlevé le format personnalisé en E8 qui mettait le bordel : tu n'en as plus besoin.
Après quelques essais, cela semble fonctionner correctement.
Concernant le fait de débugger un code et le mode pas à pas, tu peux notamment regarder ce lien.
Mais recherche sur le Net et tu trouveras pleins de choses intéressantes.
Lorsque tu sauras faire fonctionner un code en mode pas à pas, tu verras que la fonction Conso_3D est appelée à plusieurs reprises mais comme je t'ai déjà dit ce qu'il fallait faire, je n'y reviens pas : à toi d'agir maintenant.
A+

 

[Regueiro]

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

Re
Merci pour tes explications et le fichier en retour.

Encore Une question :

Dans mon code :

Public Const PWd$ = ""

Sub Wslock(Optional Y)
'Protège ou déprotège toutes les feuilles
  Application.ScreenUpdating = False
  If IsMissing(Y) Then
    For i = 1 To ThisWorkbook.Sheets.Count
      ThisWorkbook.Sheets(i).Protect PWd
      [A1].Select

    Next
  Else
    For i = 1 To ThisWorkbook.Sheets.Count
      ThisWorkbook.Sheets(i).Unprotect PWd
      [A1].Select
    Next
  End If

Si j'ai bien compris son fonctionnement.
Si je mais
Public Const PWd$ = "toto"
Tous les mots de passe de ce fichier seront toto.
Si je protège manuellementt une feuille quelconque et que je valide par Enter.
Donc je n'ai rien saisie, mais codes Unprotect et Protect fonctionneront-ils

Je tiens encore à te remercie pour ton aide efficace, même si des fois je suis long à comprendre.
Je pense que c'est le fait de travailler très tard tout les soirs sur mon programme et sur XLD
J'ai appris beaucoup à ton contact.

Je regarde attentivement tes codes ce soir.
Je me permettrais sûrement de te relancer ??

Sondage : Comment trouves-tu mon programme ??
Verrais-tu des améliorations à apportées.
Salutations.
A+

 

[david84]

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

Re
Concernant ta macro, je ne comprends pas vraiment à quoi elle te sert : quelle est pour toi son utilité dans le cadre de ton fichier ? Personnellement, je ne l'ai pas vraiment comprise (je parle de son utilité pas de la macro elle-même).
Que cherches-tu à obtenir comme résultat ?

Je tiens encore à te remercie pour ton aide efficace, même si des fois je suis long à comprendre.
Je pense que c'est le fait de travailler très tard tout les soirs sur mon programme et sur XLD

C'est pour cela que tu dois apprendre à bosser "utile", d'où les conseils sur le fait d'apprendre à déboguer un code, à le faire fonctionner en mode pas à pas, à suivre l'évolution des variables dans le code, etc.
Cela prend du temps au départ mais après tu avances beaucoup plus vite et tu gagnes en autonomie.

Sondage : Comment trouves-tu mon programme ??
Verrais-tu des améliorations à apportées.

Ben déjà je trouve qu'il est moins "usine à gaz" que la version initiale.
Des améliorations ? Surement mais comme c'est toi qui va l'utiliser, tu te rendras vite compte de ce qui manque ou qui pourrait être amélioré.
A+

 

[Regueiro]

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

Re
J'ai fais plusieurs essais, mais ?
Supprime les 4 onglets ART.001 à 004
Retourne 0.Soumission Bouton Création Onglets
Les 4 Feuilles sont crées OK.
La Feuille 004 = OK
Feuilles 1 à 3 = Problème avec mopn fameux bug ??

En fait si on créer 1 feuille à la fois c'est bon
dès que l'on e crée plusieurs à la fois, c'est la qu'il le problème
MErci
a+

 

[david84]

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

Re
Tu as raison mais as-tu compris pourquoi cela se produit ?
Tu m'obliges à retoucher ton code là, ce que je voulais éviter car je ne connais pas les possibles implications de mes modifications sur le fichier final.
Teste le code modifié :

Sub Création_Automatique_des_Onglets()
' Adaptée d'une macro de Charlize
' Modifée par BrunoM45
Dim Modele As Worksheet, NewSheet As Worksheet
Dim base_maquette As Worksheet
Dim newSheetName As String
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim Ref_CELLULES As Variant
Dim test As String

ActiveSheet.Unprotect "PWd"
' Définir les variables objet
Set Modele = Worksheets("ART.0_BASE")
Set base_maquette = Worksheets("0.Soumission")

Ref_CELLULES = Array("F8", "G8", "H8")
Application.ScreenUpdating = False

With base_maquette
    Set myRng = .Range("E8", .Cells(.Rows.Count, "E").End(xlUp))
End With

For Each myCell In myRng.Cells
    ' Définir le nom, Copie la valeur texte de la cellule
    newSheetName = "ART." & (myCell.Value)
    ' Tester si le classeur existe en récuperant la valeur d'une cellule
    On Error Resume Next
    test = Sheets(newSheetName).Range("E8")
    ' Si le numéro d'erreur est différend de 0, c'est que la feuille n'existe pas
    If Err.Number <> 0 Then
        ' On fait une copie du modèle
        Modele.Copy After:=Worksheets(Worksheets.Count)
        ' On renomme la copie
        ActiveSheet.Name = newSheetName
        ActiveSheet.Range("E8") = newSheetName
        ' On attribue les valeurs dans cette feuille
        
        For iCtr = LBound(Ref_CELLULES) To UBound(Ref_CELLULES)
            ActiveSheet.Range(Ref_CELLULES(iCtr)).Value = myCell.Offset(0, iCtr + 1).Value
        Next iCtr
        
    End If
    Sheets(newSheetName).Protect "PWd"
Next myCell
Sheets("0.Soumission").Protect "PWd"
Application.ScreenUpdating = True

Set Modele = Nothing
Set base_maquette = Nothing
Set myRng = Nothing
End Sub

Cela semble fonctionner.
Ceci-dit, si tu supprimes les feuilles 2 et 4, il va te les créer mais les onglets ne seront pas agencés dans l'ordre des ART. Est-ce important ?
A+

 

[Regueiro]

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

Bonsoir à Tous
Bonsoir David84
Voici le code qui marche après pas mal de recherche et de F8 :

Sub Création_Automatique_des_Onglets()
' Adaptée d'une macro de Charlize
' Modifée par BrunoM45
  Dim Modele As Worksheet, NewSheet As Worksheet
  Dim base_maquette As Worksheet
  Dim newSheetName As String
  Dim myRng As Range
  Dim myCell As Range
  Dim iCtr As Long
  Dim Ref_CELLULES As Variant
  Dim test As String
  
  ActiveSheet.Unprotect
  ' Définir les variables objet
  Set Modele = Worksheets("ART.0_BASE")
  Set base_maquette = Worksheets("0.Soumission")


  Ref_CELLULES = Array("E8", "F8", "G8", "H8")
  Application.ScreenUpdating = False
  With base_maquette
    Set myRng = .Range("E8", .Cells(.Rows.Count, "E").End(xlUp))
  End With
  For Each myCell In myRng.Cells
    ' Définir le nom, Copie la valeur texte de la cellule
    newSheetName = "ART." & (myCell.Value)
    ' Tester si le classeur existe en récuperant la valeur d'une cellule
    On Error Resume Next
    test = Sheets(newSheetName).Range("E8")
    ' Si le numéro d'erreur est différend de 0, c'est que la feuille n'existe pas
    If Err.Number <> 0 Then
      ' On fait une copie du modèle
      Modele.Unprotect              '**************Nouveau************
      Modele.Copy After:=Worksheets(Worksheets.Count)
      ' On renomme la copie
      ActiveSheet.Name = newSheetName
      ActiveSheet.Range("E8") = newSheetName        'NOUVEAU
      ' On attribue les valeurs dans cette feuille
      For iCtr = LBound(Ref_CELLULES) To UBound(Ref_CELLULES)
        ActiveSheet.Range(Ref_CELLULES(iCtr)).Value = myCell.Offset(0, iCtr).Value
      Next iCtr
    End If
    Modele.Protect              '***********NOUVEAU************
    Sheets(newSheetName).Protect
  Next myCell
  Sheets("0.Soumission").Protect
  Application.ScreenUpdating = True
  
  ' Il faut peut-être penser à effacer les variables objet
  Set Modele = Nothing
  Set base_maquette = Nothing
  Set myRng = Nothing
End Sub

Le problème venait que la Feuille "Modèle" = ART.0_BASE était protégé.
En fait tout mes Feuilles sont protégées avec MDP = Enter pour l'exemple qui marche chez moi.

Voilà on arrive gentillement au bout.

Concernant le code suivant dans un module :

Public Const PWd$ = "loulou"

Sub Wslock(Optional Y)
'Protège ou déprotège toutes les feuilles
  Application.ScreenUpdating = False
  If IsMissing(Y) Then
    For I = 1 To ThisWorkbook.Sheets.Count
      ThisWorkbook.Sheets(I).Protect PWd
      [A1].Select

    Next
  Else
    For I = 1 To ThisWorkbook.Sheets.Count
      ThisWorkbook.Sheets(I).Unprotect PWd
      [A1].Select
    Next
  End If
End Sub

Je voulais créer une constante Public
Pour me faciliter la vie.
Si je modifie un MDP sur mon projet, je le change une seule fois dans ce module.
Ainsi je n'ai pa besoin d'aller le modifier dans tous les codes.
Ou bien je ne sais pas si tu as une autre solution sous le bras.

Pour la suite de mon programme j'ai plein d'autres questions mais je crois que je vais recréer une nouvelle
discussion.
Exemple :
1. Saisir des Heures
je saisis : en A1 1000 => dan la même cellule au format Heure hh:mm = 10:00

2. Mise en forme du Document pour l'impression
J'aimerais trouver un code pour :
Insérer une bordure en bas de page avant chaque saut de page
Bordure pour fermer mon tableau de B:O.
Pour fignoler ??
Merci.
A+

 

[david84]

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

Re

Voici le code qui marche après pas mal de recherche et de F8 :

J'en conclus donc que tu arrives maintenant à faire fonctionner une macro en mode pas à pas...

Code :
Public Const PWd$ = "loulou"

Sub Wslock(Optional Y)
'Protège ou déprotège toutes les feuilles
Application.ScreenUpdating = False
If IsMissing(Y) Then
For I = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(I).Protect PWd
[A1].Select

Next
Else
For I = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(I).Unprotect PWd
[A1].Select
Next
End If
End Sub
Je voulais créer une constante Public
Pour me faciliter la vie.
Si je modifie un MDP sur mon projet, je le change une seule fois dans ce module.
Ainsi je n'ai pa besoin d'aller le modifier dans tous les codes.
Ou bien je ne sais pas si tu as une autre solution sous le bras.

Je n'ai pas testé mais je ne comprends pas bien l'intérêt de cette macro dans ton cas : si tu créés une constante comportant le nom de ta macro, il te suffit a priori de remplacer dans tes code le MDP par la valeur donnée à ta constante et cela doit fonctionner. Pourquoi en plus passer par ce code ?

Concernant ton format d'heure, il te suffit à priori d'utiliser un format personnalisé adapté.
La question est de savoir :
- quel type de donnée tu veux saisir et sous quelle forme (10 par ex)
- que veux-tu obtenir par le biais de ce format (10:00 par ex).
A+