Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 désactiver les filtres de plusieurs onglets et incrémenter les lignes

farnomar

XLDnaute Nouveau
Bonjour à tous

Je sollicite votre aide car je rencontre qq difficultés à mettre en place un code simple me permettant d'une part de copier une entête et d'autre part de copier les ligne des différents onglets pour tout mettre sur une seule feuille( vue globale)
voici ce que j'ai essayé de faire mais après je sèche complètement
les noms sont bien sur inventé

Sub Macro1()
'
' Macro1 Macro


'ajouter/retirer les filtres des différents onglets

Sheets("HISTO OK").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("PFMC").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("NA").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("AVENE").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("ADERMA").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("CORPORATE").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("KLORANE").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("DUCRAY").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("PFM Rx").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("RF").Select
Selection.AutoFilter
Sheets("vue Globale").Select

Sheets("PFOC").Select
Selection.AutoFilter
Sheets("vue Globale").Select

'Copier l'entête

Sheets("HISTO OK").Select
Range("A3:CF3").Select
Selection.Copy
Sheets("vue Globale").Select
Range("A3").Select
ActiveSheet.Paste

'Copier les lignes dans le tableau.

Sheets("HISTO OK").Range("A4:CF4").Copy Sheets("vue Globale").Range("A4")

et après je n'arrive pas à faire en sorte que les lignes s'incrémentent toutes en provenant des autres feuilles, j'espère que c'est assez claire
vous verrez c'est pas très propre et jolie j'ai essayé plusieurs méthodes mais en vain (sniffff)

En vous remerciant infiniment pour votre aide sur ce sujet

Cordialement,
 

Pièces jointes

  • Copie version support.xlsm
    965.5 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonjour farnomar, fanfan38, le forum,

Voyez le fichier joint et ces 2 macros :
VB:
Dim feuille 'mémorise la variable

Sub Epurer()
Dim w As Worksheet, dercel As Range, derlig&, dercol%
Set feuille = Sheets(Array("HISTO OK", "PFMC", "NA", "AVENE", "ADERMA", "CORPORATE", "KLORANE", "DUCRAY", "PFM Rx", "RF", "PFOC"))
For Each w In feuille
    w.AutoFilterMode = False 'retire le filtre automatique
    Set dercel = w.Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
    If dercel Is Nothing Then derlig = 3 Else derlig = Application.Max(dercel.Row, 3)
    w.Rows(derlig + 1 & ":" & w.Rows.Count).Delete 'supprime les lignes inutiles
    Set dercel = w.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious)
    If dercel Is Nothing Then dercol = 85 Else dercol = Application.Max(dercel.Column, 85) '85 => colonne CG
    w.Columns(dercol + 1).Resize(, w.Columns.Count - dercol).Delete 'supprime les colonnes inutiles
    With w.UsedRange: End With 'actualise les barres de défilement
Next
End Sub

Sub Copier()
Dim F As Worksheet, lig&, w As Worksheet, r As Range
Epurer 'lance la macro
Set F = Sheets("vue Globale")
Application.ScreenUpdating = False
'---copie les en-têtes---
feuille(1).Rows(3).Copy F.[A3] 'copier-coller
'---copie les lignes non vides des feuilles---
F.Rows("4:" & F.Rows.Count).Delete 'RAZ
lig = 3
For Each w In feuille
    For Each r In w.UsedRange.Rows
        If r.Row > 3 And Application.CountA(r) Then 'NBVAL
            lig = lig + 1
            r.EntireRow.Copy F.Rows(lig) 'copier-coller
        End If
Next r, w
End Sub
Commencez par Epurer : l'opération prend pas mal de temps car plusieurs feuilles sont très chargées de lignes ou colonnes inutiles.

Le poids du fichier passe alors de 966 Ko à 223 Ko.

A+
 

Pièces jointes

  • Copie version support(1).xlsm
    966.6 KB · Affichages: 15

farnomar

XLDnaute Nouveau
Bonjour messieurs et encore merci pour vos partages mais j'ai surement du mal pas très bien formuler ma requête.
Dans les faits ce que je souhaitais faire c'est
  1. dans un premier temps enlever les filtres des différents onglets
  2. dans un second temps copier les informations de chaque onglets (ranger par ranger) et de les coller dans l'onglet "vue globale" à la suite de l'entête ce qui derrière me permettra d'entreprendre un TCD
  3. et quand une nouvelle data est écrite dans peu importe l'onglet que celle-ci se colle à la suite des données dans l'onglet vue globale pour incrémenter le TCD
car en réalité les onglets sont remplie au quotidien "à la main" " je sais c'est bizarre loll" mais "on a pas encore trouvé mieux que ça même si j'ai mon idée derrière la tête".

j'espère que c'est plus parlant c'est pour cela que je séchais avec mon code qui ne faisait que de me mettre l'entête et de m'incrémenter la première ligne et j'avais pas la suite pour qu'il me fasse le fameux (+1) jusqu'a ce que les lignes soient vides

je vous remercie dans tous les cas pour ce que vous avez proposé
A très vite
 

farnomar

XLDnaute Nouveau
Visiblement vous n'avez pas essayé de comprendre ce que j'ai proposé.

Bonne nuit.
Bonjour
oui j'ai bien essayé et le résultat est correct et effectivement ca demande du temps quand on lance la macro épurer et celle de copier incremente bien les lignes après c'est à moi de le mettre en forme pour faire un TCD en éliminant les cases vides
je vous remercie infiniment pour le résultat
Top génial
 

job75

XLDnaute Barbatruc
Bonjour farnomar, le forum,

Pour faire cogiter les experts il y a une chose que je ne comprends pas sur la feuille HISTO OK.

Avant exécution de Epurer la dernière cellule (touche F5 => Cellules) est XFA1026.

Après exécution de Epurer la dernière cellule devient CJ506.

Et pourtant la barre de défilement verticale descend jusqu'à la ligne 705.

Normalement les barres de défilement s'ajustent sur la dernière cellule non ?

A+
 

farnomar

XLDnaute Nouveau
Bonjour job75,

Je reconnais à demi que le tableau en question est pas très bien bâtit ce qui crée surement cela après au travers de l'exécution de copier nous avons bien le même nombre de ligne en même quand j'en rajoute 1 elle s'incrémente quand j'active la macro copier

Surement pour répondre à la question que celui ci enlève les lignes vides
pour info j'ai essayé avec la suppression de ligne vide et la macro épurer prends moins de temps.

J'espère avoir répondu aux interrogation :
 

Deadpool_CC

XLDnaute Accro
@job75 ...
j'ai pas téléchargé le fichier mais simplement en regardant le code du ton post #3... instinctivement je me dis que les barres de défilement s'adaptent au max de données (en ligne et colonne) mais aussi en fonction de la sélection en cours.
Dans ta Sub pour épurer ... vu qu'il n'y a aucun select, je suis pas certain de ce que représente la "UsedRange" si jamais pour une raison ou une autre tu as une cellule au-delà qui est sélectionnée.
peut-être essayer de sélectionner la "A1" avant d'interroger la usedRange de la worksheet.
Je sais si c'est bien expliqué (et d'ailleurs je suis surement à coté de la plaque) mais c'est le premier truc qui me vient à l'esprit comme cela.
A+
 

job75

XLDnaute Barbatruc
Merci Deadpool_CC.

Il est facile de vérifier que le UsedRange est bien $A$1:$Cj$506.

Supprimez manuellement la plage 507:705 et enregistrez le fichier.

La barre de défilement verticale descend toujours jusqu'à la ligne 705.
 

TooFatBoy

XLDnaute Barbatruc
Oui, même constat bien sûr avec mon Excel 2016.

Et déjà avant de lancer la macro "Epurer", la dernière cellule est bien XFA1026, mais la barre de défilement verticale va jusqu'à la ligne 1867.


Supprime tous les commentaires de la feuille, et regarde si ça fait toujours pareil.


[edit]
Et juste pour rigoler cinq minutes, affiche tous les commentaires de la feuille originelle et regarde où ils sont situés...
[/edit]
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir TooFatBoy,

Et merci car effectivement si l'on sélectionne toutes les cellules et qu'on efface les commentaires la barre de défilement s'arrête à la ligne 506.

Les commentaires étaient donc bien à l'origine du problème mais je ne comprends pas pourquoi.

Puisque que la macro Epurer supprime toutes les lignes (avec les commentaires) sous le ligne 506.

Bonne nuit.
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…