Consolidation onglets

[fileofish]

Bonjour Le forum !

J'ai une question à vous poser.

Dans un dossier j'ai plusieurs fichiers Excel (30 au total)
- Chaque fichier excel à la même structure
- Je souhaite copier l'onglet "Dépenses" de chacun des 30 fichiers dans un seul qui s’appellera Consolidation.
- Dans chaque onglet "Dépenses" il y a le nom du site en cellule C3

=> Dans le fichier consolidation il y aura donc 30 onglets qui auront le nom de la cellule en C3 présent dans l'onglet Dépenses

J'ai trouvé sur internet un fichier qui ressemblerait à peu près ce que je souhaite faire que je mets en PJ mais lorsque je lance la macro elle bloque ce qui m'empêche de la tester

Si vous avez une solution ca serait super
Bonne journée à tous
Philippe

 

[fileofish]

Bonsoir tout le monde
Quelqu'un aurait-il une idée ?
Bonne soirée
Philippe

 

[fileofish]

Bonsoir Le Forum !

Je fais une dernière tentative
Si quelqu'un a des pistes je suis preneur

Bonne soirée
Philippe

 

[cathodique]

Bonjour,

Sur quelle ligne ton code bloque? D'après tes explications, le nom de l'onglet est dans la cellule C3

With ThisWorkbook
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            .ActiveSheet.Name = Ws.Name 'adapter cette ligne pour nommer l'onglet
End With

J'espère que ça répond à ta question.

 

[job75]

Bonsoir fileofish, cathodique,

Cette macro fait ce que vous avez demandé :

Sub Consolide()
Dim a, w As Worksheet, chemin$, fichier$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---suppression des feuilles---
a = Array("Feuil1", "Feuil2") 'tableau des CodeNames des feuilles à conserver
For Each w In Worksheets
  If IsError(Application.Match(w.CodeName, a, 0)) Then w.Delete
Next
'---création des onglets---
'chemin = "Y:\I&P-Domaine-Serveur-Stockage\Pole_Standardisation\Projet inventaire\Outils_Inventaire_VM\RVTools\Rapports\Rapports\"
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls")
While fichier <> ""
  If fichier <> ThisWorkbook.Name Then
    With Workbooks.Open(chemin & fichier)
      With .Sheets("Dépenses")
        .Visible = xlSheetVisible 'si la feuille est masquée
        .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ActiveSheet.Name = Left(.[C3], 31)
      End With
      .Close
    End With
  End If
  fichier = Dir
Wend
Feuil1.Activate
End Sub

Edit : ajouté .Visible = xlSheetVisible au cas où...

A+

 

[job75]

Bonjour fileofish, cathodique, le forum,

Si dans les feuilles copiées il y a des objets (boutons) ou du code VBA qu'on veut supprimer :

Sub Consolide()
Dim a, w As Worksheet, chemin$, fichier$, n%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---suppression des feuilles---
a = Array("Feuil1", "Feuil2") 'tableau des CodeNames des feuilles à conserver
For Each w In Worksheets
  If IsError(Application.Match(w.CodeName, a, 0)) Then w.Delete
Next
'---création des onglets---
'chemin = "Y:\I&P-Domaine-Serveur-Stockage\Pole_Standardisation\Projet inventaire\Outils_Inventaire_VM\RVTools\Rapports\Rapports\"
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls")
While fichier <> ""
  If fichier <> ThisWorkbook.Name Then
    With Workbooks.Open(chemin & fichier)
      With .Sheets("Dépenses")
        .Visible = xlSheetVisible 'si la feuille est masquée
        n = ThisWorkbook.Sheets.Count
        .Copy After:=ThisWorkbook.Sheets(n)
        With ThisWorkbook.Sheets(n + 1)
          .Name = Left(.[C3], 31)
          .DrawingObjects.Delete 'suppression des objets
          With .Parent.VBProject.VBComponents(.CodeName).CodeModule
            .DeleteLines 1, .CountOfLines 'suppression du code VBA
          End With
        End With
      End With
      .Close
    End With
  End If
  fichier = Dir
Wend
Feuil1.Activate
End Sub

Pour que l'accès au code VBA soit possible il faut avoir coché l'option :

- sur Excel 2003 et versions antérieures Faire confiance au projet Visual Basic (menu Outils-Macro-Sécurité-Editeurs approuvés)

- sur Excel 2007 et versions suivantes Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

A+

 

[fileofish]

Bonjour Job75, le forum

Désolé pour ma réponse tardive. En fait je n'y croyais plus trop et je ne me suis pas connecté !
Je regarde ca cette après midi et vous tiens au courant

Encore merci beaucoup c'est vraiment super sympa !!!
Philippe