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
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+
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 :
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+
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+
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+
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é :
Code:
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+
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 :
Code:
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 :
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.
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+
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+