XL 2010 Macro auto_open()

  • Initiateur de la discussion Initiateur de la discussion JPHI
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

J

JPHI

Guest
Bonjour

J'utilise la macro ci-dessous pour supprimer des doublons :

Sub Doublons()
MaCellule = "A2"
Range(MaCellule).Select
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
If ActiveCell = donnee1 Then
ActiveCell.Offset(-1, 0).Select
ActiveCell.EntireRow.Delete
donnee1 = ActiveCell
Else
donnee1 = ActiveCell


Elle marche si je la lance depuis un bouton mais elle ne marche pas quand je la met dans ma macro sub auto_open via "Call Doublons"
Quelqu'un peut t'il m'aider SVP?
Merci
 
Hello et bienvenu ici

pour bien commencer, il faudrait ton fichier exemple..

sinon;. en attendant. une idée comme ca..
quand tu lances la macro avec un bouton dans ta feuille.. je suppose que le code connait déjà la feuille active (celle ou est le bouton), donc il sait où travailler..

quand tu lances avec l'auto open (du Classeur je suppose??) cette feuille n'est pas encore connue. donc. ca plante.
il suffit (peut etre) d'ajouter une ligne en début de code
sheets("Nomfeuille").activate.


à voir avec ton fichier
 
pour le fichier il y a des infos confidentielles, sorry
par contre voici tout le code

Sub auto_open()

' Boîte de dialogue mise à jour'
If MsgBox("Bonjour Benoît, êtes-vous certain de vouloir procéder à la mise à jour des indicateurs mensuels ?", vbYesNo + vbQuestion, "Mise à jour KPI") = vbYes Then
Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"\\SFS.CORP\Apps\ICT\PC Solutions\PC L3 Support\Stat mensuelles\KPI Incidents CoreAppli Master Tools.xlsx"

Application.DisplayAlerts = False

'Suppression des colonnes K et L
Columns("K:L").Select
Selection.ClearContents

'Copie de l'onglet Closed dans "Synthèse Monthly.xlsm"
Sheets("Closed").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Synthèse Monthly.xlsm").Activate
Sheets("Closed").Select
Cells.Select
ActiveSheet.Paste
Windows("KPI Incidents CoreAppli Master Tools.xlsx").Activate


'Copie de l'onglet Received dans Synthèse Monthly.xlsm"'
Sheets("Received").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Synthèse Monthly.xlsm").Activate
Sheets("Received").Select
Cells.Select
ActiveSheet.Paste
Windows("KPI Incidents CoreAppli Master Tools.xlsx").Activate

'Copie de l'onglet Core dans Synthèse Monthly.xlsm"'
Sheets("Core Appli").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Synthèse Monthly.xlsm").Activate
Sheets("Core").Select
Cells.Select
ActiveSheet.Paste
Windows("KPI Incidents CoreAppli Master Tools.xlsx").Activate

'Copie de l'onglet Master dans Synthèse Monthly.xlsm"'
Sheets("Master").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Synthèse Monthly.xlsm").Activate
Sheets("Master").Select
Cells.Select
ActiveSheet.Paste

' Suppression des doublons
Call Doublons

Windows("KPI Incidents CoreAppli Master Tools.xlsx").Activate


'Fermeture du fichier KPI Incidents'
Windows("KPI Incidents CoreAppli Master Tools.xlsx").Close

' Copie des données du fichier misrouting'
Workbooks.Open Filename:= _
"\\SFS.CORP\Apps\ICT\PC Solutions\PC L3 Support\00 - ALL NATCO\03 - SHARE\Misrouting.xlsm" _
, UpdateLinks:=0

Range("A1:G29").Select
Selection.Copy
Windows("Synthèse Monthly.xlsm").Activate
Sheets("Misrout").Select
Range("A1").Select
ActiveSheet.Paste

'Fermeture du fichier misrouting'
Windows("Misrouting.xlsm").Activate
ActiveWorkbook.Close

'Actualisation des TCD'
ActiveWorkbook.RefreshAll

' Mise en forme de la largeur des colonnes de la feuille QoS
Sheets("QoS").Select
Columns("D:E").Select
Selection.ColumnWidth = 10
Columns("H:I").Select
Selection.ColumnWidth = 10
Columns("C:C").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Range("C3").Select

' Mise en forme de la largeur des colonnes de la feuille Misrout
Sheets("Misrouted").Select
Columns("C😀").Select
Selection.ColumnWidth = 20
Columns("F:G").Select
Selection.ColumnWidth = 20
Range("C3").Select

' Activation PerimNATCO'
Windows("Synthèse Monthly.xlsm").Activate
Sheets("Incident PerimNATCO").Select

Application.ScreenUpdating = True

' Boîte de dialogue de fin de mise à jour'
MsgBox "La mise à jour des indicateurs mensuels est terminée !", vbInformation, "Mise à jour KPI"
End If
End Sub

Sub Doublons()
MaCellule = "A2"
Range(MaCellule).Select
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
If ActiveCell = donnee1 Then
ActiveCell.Offset(-1, 0).Select
ActiveCell.EntireRow.Delete
donnee1 = ActiveCell
Else
donnee1 = ActiveCell
End If
Wend
End Sub
 
re,

je precise bien le ("Nomfeuille").activate.

même avec le post 5, je ne vois pas où est l'activation d'une feuille ou bien le référencement à une feuille dans Sub Doublons().

mais elle ne marche pas quand je la met dans ma macro sub auto_open via "Call Doublons"

C'est à dire ?
elle ne fait rien?
elle ne fait pas ce qui est prévu ?
elle plante ?

A+
 
Bonsoir à tous

JPHI (bienvenue sur le forum)
Le fichier original contient des données confidentielles
La belle affaire!
On s'en fiche du fichier original!

Nous on veut juste un fichier exemple créé pour l'occasion (par le demandeur) avec des données bidons dans le lequel il suffit de copier le code VBA existant qui pose problème

Ah ces petits nouveaux, faut les prendre en main de tout de suite, sinon ils vont prendre des mauvaises habitudes.
Et pis ça, c'est pas bon, ça me fait des aigreurs à l'estomac 😉
 
Bonjour à tous

JPHI
Sinon pour supprimer les doublons, il y a plus simple 😉
VB:
Sub Doublons()
Dim DerLig As Long
'adapter le nom de la feuille si besoin
With Sheets("Closed")
DerLig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("$A$1:$AD$" & DerLig).RemoveDuplicates Columns:=1, Header:=xlYes
End With
End Sub
 
Dernière édition:
Re à tous,

Tu as essayé ma macro Doublons en lieu et place de la tienne?

Décidement 😱🙄
Il reste ces infos confidentielles, non !!
===Customer Information===
User ID......: NTxxx
Name.........: Gildas Cxxx

La coutume ici, c'est de prendre de temps de créer un fichier exemple à partir d'un classeur vierge, pas de prendre le fichier original et de le nettoyer à la va-vite.😳
 
Dernière édition:
Re
j'ai fais:
Sub auto_open()
Call Doublons
End Sub


Sub Doublons()
Dim DerLig As Long
'adapter le nom de la feuille si besoin
With Sheets("Closed")
DerLig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("$A$1:$AD$" & DerLig).RemoveDuplicates Columns:=1, Header:=xlYes
End With
End Sub

Et ca marche!
Donc j'espère que ca marchera avec le code entier!
merci bcp
du coup c est ma macro doublons qui n allait pas? pourquoi ca marche maintenant?
 
Re

Sinon, une autre suggestion pour ta recopie des feuilles, tu peux simplifier ainsi
(A condition que les anciennes valeurs n'aient pas besoin d'être conservées
(La macro dot être dans le classeur Synthèse Monthly.xlsm
VB:
Sub CopiedesFeuilles()
Dim strPath As String, WBK_Destination As Workbook, WBK_Source As Workbook
strPath = "\\SFS.CORP\Apps\ICT\PC Solutions\PC L3 Support\Stat mensuelles\"
Set WBK_Source = Workbooks.Open(Filename:=strPath & "KPI Incidents CoreAppli Master Tools.xlsx")
Set WBK_Destination = ThisWorkbook
Application.DisplayAlerts = False
WBK_Destination.Sheets(Array("Closed", "Received", "Core Appli", "Master")).Delete
WBK_Source.Sheets(Array("Closed", "Received", "Core Appli", "Master")).Copy after:=WBK_Destination.Sheets(1)
End Sub

Ta macro ne marchait pas parce tu ne spécifiais pas sur quelle feuille elle devait agir.
Mais cela on te l'a déjà dit
vgendron d'abord puis Paf
Tu as déjà oublié?
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
546
Réponses
4
Affichages
272
  • Question Question
XL pour MAC boucle couleur
Réponses
25
Affichages
1 K
Réponses
5
Affichages
486
Réponses
5
Affichages
485
Réponses
5
Affichages
503
Retour