Problème fonctionnement code

**PurplePlan** · 21/12/2020, 17h17

Bonjour,

Je vous explique mon souci, j'ai développé un script qui permet de mettre en forme des données selon deux feuilles sélectionnées (en appliquant des formules à des cellules , des couleurs, etc..). J'avais crée une première version de ce script qui faisait le calcul automatiquement sans input ou demande de sélection de feuille par l'utilisateur et cela fonctionnait parfaitement (lien ci-joint : https://www.cjoint.com/c/JLvqnrOdbsW

Et là ou j'ai un problème c'est concernant la 2 ème version ou l'utilisateur peut sélectionner des fichiers (exemple Feuil1 et Feuil2, que vous pourrez reproduire pour tester le fichier.
Sauf que là, pas d'erreur, mais juste pas du tout le résultat escompté pour les nouveaux onglets. ( lien ci-joint :https://www.cjoint.com/c/JLvqoAkf61W

Le problème est que le 2nd If, écrase le précédent, mais je ne vois pas comment faire pour que justement les deux s'exécutent sans écraser le précédent..
(Vous pouvez lancer la macro directement depuis VB en indiquant Feuil1 et Feuil2, dans les boites de dialogue.)
La différence entre les 2 fichiers résident sur cette partie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Fichier1 = InputBox("Indiquez votre 1er Fichier à Homogénéiser", "Fichier1")
    Fichier2 = InputBox("Indiquez votre 2nd Fichier à Homogénéiser", "Fichier2")
    Fichier3 = Fichier1 & "post"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = Fichier3
 
    Worksheets(Fichier1).Range("A1:AZ128").Copy
    ActiveSheet.Paste Destination:=Worksheets(Fichier3).Range("A1:AZ128")
 
    Fichier4 = Fichier2 & "post"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = Fichier4
 
    Worksheets(Fichier2).Range("A1:AZ128").Copy
    ActiveSheet.Paste Destination:=Worksheets(Fichier4).Range("A1:AZ128")
 
    If FExist(Fichier3) Then
            Feuille_X = Fichier1
            Feuille_Y = Fichier2
        End If
        If FExist(Fichier4) Then
            Feuille_X = Fichier2
            Feuille_Y = Fichier1

Merci d'avance pour votre aide

**mfoxy** · 21/12/2020, 23h32

Bonsoir PurplePlan et Bienvenue sur le forum,

Plutôt que de poster un petit bout de votre "code" et déposer vos fichiers, que très peu de membres ouvriront pour les raisons qui sont expliquées dans les règles de ce forum.

Vous pourriez expliquer, sans jargon Excel ou Vba, ce que vous souhaitez faire. Ce sera plus simple et rapide pour comprendre votre besoin et vous aiguiller dans votre développement.

Bav,

**PurplePlan** · 21/12/2020, 23h58

Bonsoir et merci pour votre réponse.

Je vous explique en détail. L'objectif de la macro est le suivant : Un utilisateur doit pouvoir sélectionner deux onglets dans un fichier Excel (Exemple Feuil1 et Feuil2), cette sélection va créer deux nouveaux onglets qui sont le "reflet" des deux premiers sélectionnés. (Feuil1 par rapport à Feuil3 et Feuil2 par rapport à Feuil4). Ensuite on va rassembler les valeurs des deux premiers onglets avec comme principe pour le 3ème onglet par exemple, on recopie les valeurs du premier et on rajoute les secondes en appliquant un surlignage (pour les distinguer), et inversement pour le 4ème onglet. Par la suite on y applique une formule pour faire des calculs d'homogénéisation.
Feuil1
Nom : Feuil1.PNG
Affichages : 102
Taille : 14,6 Ko

Nom : Feuil1.PNG
Affichages : 102
Taille : 14,6 Ko

Feuil2

Feuil3

Feuil4

Tout fonctionne, sauf que le résultat attendu sur la Feuil3, devrait être quelque chose de similaire à la Feuil4, et là, ne fait qu'une simple copie de la première Feuille.
Je pense savoir d'où vient mon problème, mais je ne sais pas du tout comment régler ce souci.

J'ai l'impression que mon premier If mentionné précédemment écrase le premier. Mais j'ignore comment créer une boucle ou autre pour que ma macro prenne en compte les deux.

Mon code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Option Explicit
Function FExist(NomF As String) As Boolean ' test si la feuille existe
   Application.ScreenUpdating = False
   On Error Resume Next
   FExist = Not Sheets(NomF) Is Nothing
   Application.ScreenUpdating = True
End Function
Sub tata1aze0()
    Dim i As Integer, j As Integer, k As Integer, m As Integer, Feuille_X As String, Feuille_Y As String, Ligne_vide As Integer
    Dim Ligne_du_haut As Integer, Ligne_du_bas As Integer, Nombre_de_lignes As Integer, Nombre_de_colonnes As Byte
 
    Dim Fichier1 As String
    Dim Fichier2 As String
    Dim Fichier3 As String
    Dim Fichier4 As String
 
    Application.ScreenUpdating = False
    Fichier1 = InputBox("Indiquez votre 1er Fichier ? Homog?n?iser", "Fichier1")
    Fichier2 = InputBox("Indiquez votre 2nd Fichier ? Homog?n?iser", "Fichier2")
    Fichier3 = Fichier1 & "post"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = Fichier3
 
    Worksheets(Fichier1).Range("A1:AZ128").Copy
    ActiveSheet.Paste Destination:=Worksheets(Fichier3).Range("A1:AZ128")
 
    Fichier4 = Fichier2 & "post"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = Fichier4
 
    Worksheets(Fichier2).Range("A1:AZ128").Copy
    ActiveSheet.Paste Destination:=Worksheets(Fichier4).Range("A1:AZ128")
 
 
    With ActiveSheet
        Range("A2:Z" & Rows.Count).ClearContents
        Range("A2:Z" & Rows.Count).Interior.Pattern = xlNone
 
        If FExist(Fichier3) Then
            Feuille_X = Fichier1
            Feuille_Y = Fichier2
        End If
        If FExist(Fichier4) Then
            Feuille_X = Fichier2
            Feuille_Y = Fichier1
        End If
 
        Nombre_de_colonnes = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        Sheets(Feuille_X).Range("A2:Z" & Sheets(Feuille_X).Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A2")
        Ligne_vide = .Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheets(Feuille_Y).Range("A2:a" & Sheets(Feuille_Y).Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Ligne_vide)
        With .Range(.Cells(Ligne_vide, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, Nombre_de_colonnes)).Interior
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.8
        End With
        For i = .Range("A" & Rows.Count).End(xlUp).Row To Ligne_vide Step -1
            On Error Resume Next
            j = Application.WorksheetFunction.Match(.Range("A" & i), .Range("A2:A" & Ligne_vide - 1), 0)
                If j > 0 Then .Rows(i).Delete
            j = 0
        Next i
        .Range("A1:Z" & Rows.Count).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
 
        .Range("B2").Activate
 
Retour:
 
        Do Until ActiveCell.Offset(1, 0) = ""
            ActiveCell.Offset(1, 0).Activate
        Loop
        Ligne_du_haut = ActiveCell.Row
        ActiveCell.Offset(1, 0).Activate
        Do Until ActiveCell.Offset <> ""
            If ActiveCell.Offset(1, -1) = "" Then Exit Sub
            ActiveCell.Offset(1, 0).Activate
        Loop
        Ligne_du_bas = ActiveCell.Row
 
        For k = 2 To Nombre_de_colonnes
            For m = Ligne_du_haut + 1 To Ligne_du_bas - 1
                Cells(m, k) = Round(Cells(Ligne_du_haut, k) + ((Cells(Ligne_du_bas, k) - Cells(Ligne_du_haut, k)) / (Cells(Ligne_du_bas, 1) - Cells(Ligne_du_haut, 1))) * (Cells(m, 1) - Cells(Ligne_du_haut, 1)), 3)
            Next m
        Next k
 
        Range("B" & Ligne_du_bas).Activate
        GoTo Retour
 
    End With ' ActiveSheet
 
End Sub

Pour le tester dans les mêmes circonstances que moi, créer tout simplement deux onglets avec des tableaux simples comme dans mon exemple.

Merci beaucoup et bonne soirée !