XL 2016 Problème ActiveSheet

[Hogwarts]

Bonjour,

Je poste mon problème ici suite aux conseils d'un proche, et n'ayant pas trouvé de solutions sur les autres Forum dédié à Excel.

Je vous explique, j'ai un fichier sur lequel se trouve 2 onglets Excel : Feuil1 et Feuil2

Voici comment ma macro devrait fonctionner : je selectionne dans des Input qui apparaissent au lancement de la macro, successivement Feuil1 et Feuil2.
La macro si elle fonctionnait comme je le souhaite devrait effectuer la création de nouveau onglet Feuil3 et Feuil4 qui sont respectivement une copie (Pour Feuil3 de Feuil1 et Feuil2 et pour Feuil4, de Feuil2 et Feuil1).
Puis à tout ça se rajoute un ajout de formule pour faire une homogénéisation.

Le problème est que la Feuil3 fait uniquement une copie de ma Feuil1 alors qu'elle devrait faire la même chose que pour la Feuil4 mais en partant de Feuil1 comme feuille d'origine.
(Vous pouvez voir que sur la Feuil4 les données en couleur sont celles de la Feuil1 alors que les données en clair sont celles de la Feuil2)

Ma macro fonctionnait quand je n'avais pas d'input mais deconne avec. Je pense que le problème vient de la partie "With ActiveSheet" mais je ne comprends pas comment le résoudre....

Merci d'avance, et si vous avez besoin de renseignements supplementaire, il y a pas de souci.

 

[Hogwarts]

Bonjour,

Code à tester. J'ai fait quelques retouches à ton code qui fonctionne, pour l'adapter à mes ajouts.

Option Explicit
Option Compare Text
Sub homogeneisation()
   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, Fichier2 As String, Sht As Worksheet

   Application.ScreenUpdating = False

   ''pour éviter saisie nom feuil1
retour1:
   Fichier1 = InputBox("Indiquez votre 1er Fichier à Homogénéiser", "Fichier1")
   If Fichier1 = "" Then
      MsgBox "Vous avez annulé le choix de la 1ère feuille!", vbOKOnly + vbInformation, "ANNULATION UTILISATEUR"
   Else
      'Sheets(1) et Sheets(2) sont les feuilles contenants les données (adapter les indexes)
      If Fichier1 = Sheets(1).Name Or Fichier1 = Sheets(2).Name Then
         MsgBox "Non autorisé! correspond à la source de données." & vbLf & "Saisir un autre nom de feuille.", vbCritical + vbOKOnly, "ECHEC NOM FEUILLE"
         GoTo retour1
      End If
   End If
   '   Stop
   ''pour éviter saisie nom feuil2
retour2:
   Fichier2 = InputBox("Indiquez votre 2nd Fichier à Homogénéiser", "Fichier2")
   If Fichier2 = "" Then
      MsgBox "Vous avez annulé le choix de la 2nd feuille!", vbOKOnly + vbInformation, "ANNULATION UTILISATEUR"
   Else
      'Sheets(1) et Sheets(2) sont les feuilles contenants les données (adapter les indexes)
      If Fichier1 = Sheets(1).Name Or Fichier1 = Sheets(2).Name Then
         MsgBox "Non autorisé! correspond à la source de données." & vbLf & "Saisir un autre nom de feuille.", vbCritical + vbOKOnly, "ECHEC NOM FEUILLE"
         GoTo retour2
      End If
      If Fichier2 = Fichier1 Then
         MsgBox "Modifier! Correspond à Feuille: " & Fichier1 & " déjà saisi.", vbCritical + vbOKOnly, "ECHEC NOM FEUILLE"
         GoTo retour2
      End If
   End If

   '   Stop
   'si utilisateur a cliqué sur Cancel pour 2 inputbox on sort de la procédure
   If Fichier1 = "" Or Fichier2 = "" Then Exit Sub

   'on vérifie si les noms de feuille saisis existe

   If Not FExist(Fichier1) Then
      Sheets.Add(after:=Sheets(Sheets.Count)).Name = Fichier1
   Else
      Sheets(Fichier1).Cells.Clear
   End If


   If Not FExist(Fichier2) Then
      Sheets.Add(after:=Sheets(Sheets.Count)).Name = Fichier2
   Else
      Sheets(Fichier2).Cells.Clear
   End If

   For Each Sht In Worksheets(Array(Fichier1, Fichier2))
      With Sht
         .Activate
         If .Name = "Feuil3" Then
            Feuille_X = "Feuil1"
            Feuille_Y = "Feuil2"
         Else
            Feuille_X = "Feuil2"
            Feuille_Y = "Feuil1"
         End If

         Sheets(Feuille_X).Range("A1:Z" & Sheets(Feuille_X).Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A1")
         Nombre_de_colonnes = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
         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 GoTo fin
            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
fin:
Next Sht

End Sub
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

Bonne journée

Bonjour Cp4 et merci pour ta réponse.

Cependant le code que tu me proposes ne m'aide pas tellement puisque c'est un mixte des deux (celui qui fonctionne et celui qui ne fonctionne pas).

Et si je ne dis pas de bêtises, tu supprimes les données des deux feuilles sélectionnées par l'utilisateur, donc la macro s'arrête un peu plus bas, puisqu'il n'y a plus de colonnes.

Je vais continuer à essayer de travailler dessus, bonne journée également.

 

[Staple1600]

Bonjour le fil

[aparté émotionnel]

Cependant le code que tu me proposes ne m'aide pas tellement puisque c'est un mixte des deux (celui qui fonctionne et celui qui ne fonctionne pas).

Si j'étais moi, ou plutôt si j'étais demandeur, j'éviterai ce genre de phrases.
Car les répondeurs que nous sommes, bénévolement, passent du temps à essayer d'aider les demandeurs.
Alors quand nos yeux, fatigués de trop de VBA, tombent sur ce type de propos, nous en sommes bouleversifiés.
Certains appellent leur mère, d'autres boivent une rasade d'un alcool fort pour surmonter le choc.

[/aparté émotionnel]

 

[Hogwarts]

J'avoue ne plus comprendre tes attentes.

L'utilisateur ne fait pas de sélection, il saisit le nom des feuilles sur lesquelles ton code va s’exécuter ou bien les créer pour qu'ensuite s’exécute. Dans l'éventualité que les feuilles existent, elles sont vidées. C'est ce que fait ton code avec ces 2 lignes ci-dessous:

With ActiveSheet
        .Range("A2:Z" & Rows.Count).ClearContents
        .Range("A2:Z" & Rows.Count).Interior.Pattern = xlNone
      
        'suite de ton code'

Or, tu me dis que mon code supprime les données. J'ai refait à ma manière ce que fait ton code.
Tu vides les feuilles de destination, oui ou non?! La macro ne s'arrête pas, voici une démo du résultat obtenu.
Regarde la pièce jointe 1090025
Bon courage pour la suite.

edit: si l'utilisateur se trompe en saisissant le même nom de feuille, il est averti et invité à modifier.
Regarde la pièce jointe 1090028

Je suis vraiment désolé, je n'avais pas compris que tu partais de ce fichier là, c'est de ma faute.

C'est parfait, ça répond à ma demande ! Merci beaucoup

 

[Hogwarts]

Bonjour le fil

[aparté émotionnel]

Si j'étais moi, ou plutôt si j'étais demandeur, j'éviterai ce genre de phrases.
Car les répondeurs que nous sommes, bénévolement, passent du temps à essayer d'aider les demandeurs.
Alors quand nos yeux, fatigués de trop de VBA, tombent sur ce type de propos, nous en sommes bouleversifiés.
Certains appellent leur mère, d'autres boivent une rasade d'un alcool fort pour surmonter le choc.

[/aparté émotionnel]

Bonjour,

C'était vraiment très maladroit de ma part, je m'excuse une nouvelle fois.

Merci à tous pour votre aide et passer de bonne fête de fin d'année

 

[cp4]

Je suis vraiment désolé, je n'avais pas compris que tu partais de ce fichier là, c'est de ma faute.

Tu as combien de fichiers? Pas rigolo du tout, de joindre un fichier et utiliser un autre.
Comme le moral est au beau fixe en cette fin d'année, je le prends du bon côté.
Pas très malin de faire déclencher la macro à partir de(s) feuille(s) de destination qui pourraient éventuellement ne pas exister. Plutôt, utiliser un bouton ou un raccourci à mettre en place dans l'option de la macro.

 

[Staple1600]

Re

=>Hogwarts
Je rassure, c'était juste un trait d'humour dont je suis coutumier sur XLD
(C'est pour cela que j'avais laissé un smiley en indice)
De toute façon, nous répondeurs, avons le cuir dur.
Nous avons pour la plupart passé une certification "Survivre à un forum" après 15 jours de stage dans une base militaire tibétaine tenu par des moines qui ont dédié leur vie à Excel et à la déesse ShiVBA


=>cp4
Meilleurs voeux également

 

[Hogwarts]

Tu as combien de fichiers? Pas rigolo du tout, de joindre un fichier et utiliser un autre.
Comme le moral est au beau fixe en cette fin d'année, je le prends du bon côté.
Pas très malin de faire déclencher la macro à partir de(s) feuille(s) de destination qui pourraient éventuellement ne pas exister. Plutôt, utiliser un bouton ou un raccourci à mettre en place dans l'option de la macro.

Je suis partie du tout premier fichier que j'avais posté sur le forum et non du dernier que je t'avais adressé "Homogénéisation.xlsx"
Merci beaucoup pour ta patience et également ton aide.