XL 2016 Problème ActiveSheet

Hogwarts

XLDnaute Nouveau
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.
 

Pièces jointes

  • test-homogeneisation-v3.xlsm
    17.1 KB · Affichages: 35
Solution
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.
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...

chris4785478547

XLDnaute Junior
Bonjour le fil, Hogwarts,

Après avoir pas mal été aidé ici, j'ai sans doute ta solution.
J'ai rencontré le problème avec des with qui me semblaient ignorés... oui et pour cause nous faisons une erreur de syntaxe, pour que ton with serve à quelque chose, il te faut mettre un point devant ton range, pour dire que cette instruction doit fonctionner avec le with:
VB:
 With ActiveSheet
        .Range("A2:Z" & Rows.Count).ClearContents
        .Range("A2:Z" & Rows.Count).Interior.Pattern = xlNone

Ca devrait beaucoup mieux marcher !
 

chris4785478547

XLDnaute Junior
Re:
=>Hogwarts,
Dans ces conditions, pas sûr que ce soit de mon niveau, mais je vais regarder, si besoin + d'infos je reviens vers toi...
Après m'être rapidement penché sur ta macro, je suis désolé mais je n'ai pas encore assez d'expérience sur vba pour pouvoir t'aider.
En revanche, retiens tout de même ce que je t'ai dit car, si cela ne résout pas ton problème aujourd'hui car il y a un autre pbme, tu seras bloqué très vite à cause ce ça.
Cordialement
 
Dernière édition:

Hogwarts

XLDnaute Nouveau
Re:
=>Hogwarts,
Dans ces conditions, pas sûr que ce soit de mon niveau, mais je vais regarder, si besoin + d'infos je reviens vers toi...
Après m'être rapidement penché sur ta macro, je suis désolé mais je n'ai pas encore assez d'expérience sur vba pour pouvoir t'aider.
En revanche, retiens tout de même ce que je t'ai dit car, si cela ne résout pas ton problème aujourd'hui car il y a un autre pbme, tu seras bloqué très vite à cause ce ça.
Cordialement
Je te remercie en tout cas de t'être penché sur ma macro, et également pour ce petit tuyau pour les with !
Passe de bonne fête de fin d'année
 

cp4

XLDnaute Barbatruc
Bonsoir @Hogwarts , @chris4785478547 ,

==> @Hogwarts : Pourrais-tu ajouter manuellement les 2 feuilles et le résultat escompté sur ces dernières.

A+

edit: gestion des inputboxs dans le cas où l'utilisateur clique sur Cancel
VB:
Application.ScreenUpdating = False
   Fichier1 = InputBox("Indiquez votre 1er Fichier à Homogénéiser", "Fichier1", "Feuil1")
   If Fichier1 = "" Then
      MsgBox "Vous avez annulé le choix de la 1ère feuille!", vbOKOnly + vbInformation, "ANNULATION UTILISATEUR"
   End If

   Fichier2 = InputBox("Indiquez votre 2nd Fichier à Homogénéiser", "Fichier2", "Feuil2")
   If Fichier2 = "" Then
      MsgBox "Vous avez annulé le choix de la 2nd feuille!", vbOKOnly + vbInformation, "ANNULATION UTILISATEUR"
   End If
 
   If Fichier1 = "" Or Fichier2 = "" Then Exit Sub
 
Dernière édition:

Hogwarts

XLDnaute Nouveau
Bonsoir @Hogwarts , @chris4785478547 ,

==> @Hogwarts : Pourrais-tu ajouter manuellement les 2 feuilles et le résultat escompté sur ces dernières.

A+

edit: gestion des inputboxs dans le cas où l'utilisateur clique sur Cancel
VB:
Application.ScreenUpdating = False
   Fichier1 = InputBox("Indiquez votre 1er Fichier à Homogénéiser", "Fichier1", "Feuil1")
   If Fichier1 = "" Then
      MsgBox "Vous avez annulé le choix de la 1ère feuille!", vbOKOnly + vbInformation, "ANNULATION UTILISATEUR"
   End If

   Fichier2 = InputBox("Indiquez votre 2nd Fichier à Homogénéiser", "Fichier2", "Feuil2")
   If Fichier2 = "" Then
      MsgBox "Vous avez annulé le choix de la 2nd feuille!", vbOKOnly + vbInformation, "ANNULATION UTILISATEUR"
   End If

   If Fichier1 = "" Or Fichier2 = "" Then Exit Sub
Bonjour,

Et merci pour votre réponse, ceci pourra toujours m'être utile !
Voici un fichier qui fonctionne comme je le souhaiterai.
Mais avec un code qui s'actualise de manière automatique. Maintenant je souhaiterai le même résultat mais avec le code du premier fichier envoyé.

Merci d'avance pour votre aide !
 

Pièces jointes

  • Homogénéisation.xlsm
    26.7 KB · Affichages: 7

cp4

XLDnaute Barbatruc
Bonjour,

Et merci pour votre réponse, ceci pourra toujours m'être utile !
Voici un fichier qui fonctionne comme je le souhaiterai.
Mais avec un code qui s'actualise de manière automatique. Maintenant je souhaiterai le même résultat mais avec le code du premier fichier envoyé.

Merci d'avance pour votre aide !
Re,

Pas très clair! Tu nous présentes un fichier pour lequel ta macro te donne satisfaction.
Dans ton premier message, tu as mis en place 2 inputboxs dans lesquelles le choix est prédéterminé.
Ensuite, tu parles de feuilles alors que dans le code, il est question de fichier.
VB:
Fichier1 = InputBox("Indiquez votre 1er Fichier à Homogénéiser", "Fichier1", "Feuil1")

Tel quel, je suppose que tu veux récupérer des données d'un fichier. Si ce n'est pas le cas, ton code est suffisant, tu te complique les choses inutilement.
Merci de nous dire ce que tu cherches à faire exactement.

nb: comme te l'avait précisé @chris4785478547 , ajoute le point avant range quand tu utilises With...End With
Code:
With ActiveSheet
 .Range("A2:Z" & Rows.Count).ClearContents
 .Range("A2:Z" & Rows.Count).Interior.Pattern = xlNone
 End With


Bonne soirée.
 

Hogwarts

XLDnaute Nouveau
Re,

Pas très clair! Tu nous présentes un fichier pour lequel ta macro te donne satisfaction.
Dans ton premier message, tu as mis en place 2 inputboxs dans lesquelles le choix est prédéterminé.
Ensuite, tu parles de feuilles alors que dans le code, il est question de fichier.
VB:
Fichier1 = InputBox("Indiquez votre 1er Fichier à Homogénéiser", "Fichier1", "Feuil1")

Tel quel, je suppose que tu veux récupérer des données d'un fichier. Si ce n'est pas le cas, ton code est suffisant, tu te complique les choses inutilement.
Merci de nous dire ce que tu cherches à faire exactement.

nb: comme te l'avait précisé @chris4785478547 , ajoute le point avant range quand tu utilises With...End With
Code:
With ActiveSheet
.Range("A2:Z" & Rows.Count).ClearContents
.Range("A2:Z" & Rows.Count).Interior.Pattern = xlNone
End With


Bonne soirée.
 

Hogwarts

XLDnaute Nouveau
Cp4,

Le dernier fichier que je vous ai envoyé est la version qui fonctionnait mais pour cela il faut avoir créée les feuilles avant et connaître le nom des Feuilles à l'avance.

Cependant ma demande pour le premier fichier que j'ai envoyé et que je souhaite que l'utilisateur puisse indiquer le nom des 2 Feuilles et ensuite la macro fait exactement le même travail que dans le fichier Homogénéisation.

J'ai nommé Fichier pour me retrouver dans mon code mais Fichier 1,2,3,4 correspondent aux Feuilles 1,2,3,4

J‘espère avoir été plus clair !

Merci pour ton aide en tout cas
 

cp4

XLDnaute Barbatruc
Bonjour,

Code à tester. J'ai fait quelques retouches à ton code qui fonctionne, pour l'adapter à mes ajouts.
VB:
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
 
Dernière édition:

Hogwarts

XLDnaute Nouveau
Bonjour,

Code à tester. J'ai fait quelques retouches à ton code qui fonctionne, pour l'adapter à mes ajouts.
VB:
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.
 

cp4

XLDnaute Barbatruc
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.
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:
VB:
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.
Hogwarts.gif

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.
Hogwarts1.gif
 

Pièces jointes

  • Homogénéisation_retour.xlsm
    43.1 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
312 203
Messages
2 086 192
Membres
103 152
dernier inscrit
Karibu