XL 2010 Macro auto_open()

[JPHI]

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

 

[vgendron]

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

 

[JPHI]

Hello et merci

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

 

[Paf]

Bonjour JPHI, vgendron,

D'accord avec le diagnostic de vgendron, aucun éléments n'est référencé à une feuille !

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

si ce code se trouve bien dans la macro, pourquoi nous soumettre une macro incomplète ?

A+

 

[JPHI]

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

 

[Paf]

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+

 

[Staple1600]

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

 

[Staple1600]

Bonjour à tous

JPHI
Sinon pour supprimer les doublons, il y a plus simple

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

 

[Staple1600]

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.

 

[JPHI]

Oui à l'instant, merci bcp!

 

[JPHI]

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?

 

[Staple1600]

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

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é?

 

[JPHI]

a mon age on oublie vite!
je testerais lundi
merci!