Macro dans un fichier partage

cs_cgregueusse Messages postés 7 Date d'inscription vendredi 7 mai 2004 Statut Membre Dernière intervention 10 juin 2008 - 9 juin 2008 à 23:53
cs_cgregueusse Messages postés 7 Date d'inscription vendredi 7 mai 2004 Statut Membre Dernière intervention 10 juin 2008 - 10 juin 2008 à 22:30
Bonjour à tous,
J'ai un gros soucis.
J'ai un classeur avec X feuille.
Je souhaite copier le contenu de chaque feuille dans la premiere pour pouvoir effectuer des filtres auto.
Jusque la ca va j'arrive à tout copier et tout visualiser.
Cependant en mode partage Ma macro met beaucoup trop de temps à s'effectué.
..... qq un à deja eu ce prob.
Merci

3 réponses

mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
10 juin 2008 à 06:04
salut,

donne nous ton code, il y aura peut-être des optimisations à faire

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
0
cs_cgregueusse Messages postés 7 Date d'inscription vendredi 7 mai 2004 Statut Membre Dernière intervention 10 juin 2008
10 juin 2008 à 22:20
En fait j'ai trouvé,
Avant de remplir ma feuille j'utilise la méthode Clear.
Lorsque je suis en mode seule elle passe.
Cependant lorsque je suis en mode partage elle plante.
Malgres tout ca je ne vois pas comment efface ma feuille autrement....
0
cs_cgregueusse Messages postés 7 Date d'inscription vendredi 7 mai 2004 Statut Membre Dernière intervention 10 juin 2008
10 juin 2008 à 22:30
Voila le code :


 


Private Sub Worksheet_Activate()
' Recherche et mise à jour de la liste globale
     
    Dim NbrLig As Integer
    Dim iIndex As Integer
       
    On Error GoTo Error
       
    Application.DisplayAlerts = False
    '.................................................................
    ' INIT VUE GLOBALE
    '.................................................................
    Worksheets("Synthese").Range("A3:Z65000").Clear
    iIndex = 3
    '.................................................................
    ' GESTION PDM Qualite
    '.................................................................
    NbrLig = Worksheets("PDM Qualite").Cells(65536, 1).End(xlUp).Row
    Worksheets("PDM Qualite").Range("A3:Z" & NbrLig).Copy
    NbrLig = NbrLig - 3
    Worksheets("Synthese").Range("B" & iIndex).Select
    Worksheets("Synthese").Paste
    Range("A" & iIndex & ":A" & (NbrLig + iIndex)).Value = "PDM Qualite"
    iIndex = iIndex + NbrLig + 1
    '.................................................................
    ' GESTION PDM Logistique
    '.................................................................
    NbrLig = Worksheets("PDM Logistique").Cells(65536, 1).End(xlUp).Row
    Worksheets("PDM Logistique").Range("A3:Z" & NbrLig).Copy
    NbrLig = NbrLig - 3
    Worksheets("Synthese").Range("B" & iIndex).Select
    Worksheets("Synthese").Paste
    Range("A" & iIndex & ":A" & (NbrLig + iIndex)).Value = "PDM Logistique"
    iIndex = iIndex + NbrLig + 1
    '.................................................................
    ' GESTION RT Maintenance
    '.................................................................
    NbrLig = Worksheets("RT Maintenance").Cells(65536, 1).End(xlUp).Row
    Worksheets("RT Maintenance").Range("A3:Z" & NbrLig).Copy
    NbrLig = NbrLig - 3
    Worksheets("Synthese").Range("B" & iIndex).Select
    Worksheets("Synthese").Paste
    Range("A" & iIndex & ":A" & (NbrLig + iIndex)).Value = "RT Maintenance"
    iIndex = iIndex + NbrLig + 1
    '.................................................................
    ' GESTION PDM ROJ
    '.................................................................
    NbrLig = Worksheets("PDM ROJ").Cells(65536, 1).End(xlUp).Row
    Worksheets("PDM ROJ").Range("A3:Z" & NbrLig).Copy
    NbrLig = NbrLig - 3
    Worksheets("Synthese").Range("B" & iIndex).Select
    Worksheets("Synthese").Paste
    Range("A" & iIndex & ":A" & (NbrLig + iIndex)).Value = "PDM ROJ"
    iIndex = iIndex + NbrLig + 1
    '.................................................................
    ' GESTION RT Engineering
    '.................................................................
    NbrLig = Worksheets("RT Engineering").Cells(65536, 1).End(xlUp).Row
    Worksheets("RT Engineering").Range("A3:Z" & NbrLig).Copy
    NbrLig = NbrLig - 3
    Worksheets("Synthese").Range("B" & iIndex).Select
    Worksheets("Synthese").Paste
    Range("A" & iIndex & ":A" & (NbrLig + iIndex)).Value = "RT Engineering"
    iIndex = iIndex + NbrLig + 1
    '.................................................................
    ' GESTION PDM ROH
    '.................................................................
    NbrLig = Worksheets("PDM ROH").Cells(65536, 1).End(xlUp).Row
    Worksheets("PDM ROH").Range("A3:Z" & NbrLig).Copy
    NbrLig = NbrLig - 3
    Worksheets("Synthese").Range("B" & iIndex).Select
    Worksheets("Synthese").Paste
    Range("A" & iIndex & ":A" & (NbrLig + iIndex)).Value = "PDM ROH"
    iIndex = iIndex + NbrLig + 1
   
   
    Worksheets("Synthese").Range("B2").Select
    ActiveWorkbook.Save
    Application.DisplayAlerts = True


Exit Sub
Error:
    MsgBox Err.Description
   
End Sub

biensur on peut optimiser ca avec une boucle
0
Rejoignez-nous