Compiler Feuilles d'un meme classeur

banpo

XLDnaute Junior
Bonjour ,


Je dois traiter des fichiers Excel contenant chacuns de nombreuses feuilles. Le nombre de feuilles par fichier est variable mais chaque feuille se presente toujours sous le meme format ( meme nombre de colonnes (5), meme entete, meme position dans la feuille. Le nombre de lignes est toutefois lui aussi variable).

Afin de traiter les donnees de chaque fichier, je souhaite ecrire une macro pour automatiser les taches suivantes:
1/ Compiler toutes les feuilles d'un meme classeur sur une seule feuille
2/ Dans la feuille compilee, effacer les lignes pour lesquelles la valeur dans la collonne 1 est nulle
3/ Dans la feuille compilee, effacer les colonnes 2 et 3.

J'ai commence la macro avec un bout de code trouve sur internet mais il ne semble pas fonctionne car il ne copie que la derniere feuille. Quelqu'un voit -il d'ou vient le pb ? Y-a-il une erreur dans le code ?
Par ailleurs, je ne vois pas comment le completer pour realiser 2/ et 3/ . Quelqu'un peut-il m'aider ? ( je suis debutant en macro....)

Merci pour votre aide

Sub Combine()
Dim J As Integer

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Select ' select all cells in this sheets

' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Compiler Feuilles d'un meme classeur

Bonjour Banpo, bonjour le forum,

La macro modifiée :

Code:
Sub Combine()
Dim J As Integer
Dim dl As Long
Dim x As Long
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
With Sheets("Combined")
    .Columns("B:C").Delete Shift:=xlToLeft
    dl = .Range("A65536").End(xlUp).Row
    For x = dl To 2 Step -1
        If .Cells(x, 1).Value = 0 Then .Rows(x).Delete
    Next x
End With
End Sub
 

banpo

XLDnaute Junior
Re : Compiler Feuilles d'un meme classeur

Merci beaucoup Robert. Ca fonctionne parfaitement.

Sans vouloir abuser, j'ai deux questions supplementaires:
1/ comment modifier le code pour que la ligne supprimee corresponde a la condition "valeur colone A"=0 et "valeur colonne D"=0 ?

2/ je souhaiterais realiser la variante suivante:
Je voudrais sauvegarder la consolidation du classeur non pas sur une feuille du meme classeur mais dans un classeur separe ( classeur avec une seule feuille appelee "consolidated"). Ce classeur se trouverait dans le meme repertoire que tous les autres classeurs. La macro aurait pour fonction de venir rajouter les lignes de toutes les feuilles du classeur traite dans le fichier "consolidated". A chaque excution de la macro, toutes les feuilles du classeur traite viendraient se rajouter au bas du tableau deja existant . (pour cette variante, pas de suppression de lignes ou de colonnes, juste une consolidation au format d'origine). En d'autres termes, "consolidated" serait la consolidation de tous les classeurs traites.
Cela parait-il possible ?

Olivier
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Compiler Feuilles d'un meme classeur

Bonjour Banpo, bonjour le forum,

Remplace cette partie :
Code:
For x = dl To 2 Step -1
        If .Cells(x, 1).Value = 0 Then .Rows(x).Delete
    Next x

Par celle-ci :
Code:
    For x = dl To 2 Step -1
        If .Cells(x, 1).Value = 0 And .Cells(x, 4).Value = 0 Then .Rows(x).Delete
    Next x

Pour le reste, juste une question : Ne serait-il pas intéressant de séparer la consolidation de multiples classeurs par une ligne contenant le nom de ce classeur et éventuellement la date et l'heure ? Car sinon tu vas te retrouver avec un liste sans en connaître la provenance.
Proposition à suivre après ta réponse...
 

banpo

XLDnaute Junior
Re : Compiler Feuilles d'un meme classeur

Merci pour cette suggestion. Cela me permettra en effet de m'y retrouver dans les differentes compilations. Par contre , je prefererai si possible ne pas avoir de separation dans le tableau des donnees ( 5 colonnes) et plutot inserer le nom du classeur et la date sur la premiere ligne ajoutee , en demarrant a la colonne 6. Cela me permet de garder la structure des donnees d'origine.

Merci encore pour toute ton aide.

OE
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Compiler Feuilles d'un meme classeur

Bonjour Banpo, bonjour le forum,

Crée un nouveau Classeur nommé Consolidated.xls avec un seul onglet nommé lui aussi Consolidated. Attention ! Il faut que ce classeur soit impérativement ouvert quand tu lanceras la macro.

Copie la macro ci-dessous sur tous les classeurs dont tu voudras récupérer les données. Lance la macro à partir du classeur pour chaque classeur...

Code:
Sub Consolidated()
Dim o As Workbook 'déclare la variable o (classeur Origine)
Dim c As Workbook 'déclare la variable c (classeur Cible)
Dim f As Worksheet 'déclare la variable f (Feuille)
Dim x As Integer 'déclare la variable x
Dim dest As Range 'déclare la variable dest (DESTination)
Dim p As Range 'déclare la variable p (Plage)
 
Set o = ThisWorkbook 'définit la variable o
Set c = Workbooks("Consolidated.xls") 'définit la variable c
Set f = c.Sheets("Consolidated") 'définit la variable f
 
' copie les étiquettes
o.Sheets(1).Range("A1").EntireRow.Copy Destination:=f.Range("A1")
 
' copie des données
For x = 1 To Sheets.Count 'boucle sur tous les onglets
 
    'si l'onglet est "Combined" passe à l'onglet suivant via l'étiquette "fin"
    If Sheets(x).Name = "Combined" Then GoTo suite
 
    Set dest = f.Range("A65536").End(xlUp).Offset(1, 0) 'défnit la variable dest
    dest.Offset(0, 5).Value = o.Name 'copie le nom du classeur sur la première ligne vide
    dest.Offset(0, 6).Value = Sheets(x).Name 'copie le nom de l'onglet en cours
    dest.Offset(0, 7).Value = Date 'copie la date
    Sheets(x).Activate 's'électionne l'onglet de la boucle
    Set p = Range("A1").CurrentRegion 'définit la variable p
    ' redéfinit la variable p sans les titres
    Set p = p.Offset(1, 0).Resize(p.Rows.Count - 1)
    'copie et colle les données
    p.Copy Destination:=dest
 
suite: 'étiquette
 
Next x
 
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Compiler Feuilles d'un meme classeur

Bonjour Banpo, Jean-Marie, bonjour le forum,

Histoire de pouvoir saluer ce cher Jean-Marie qu veille au grain...

Oui c'est une autre manière de voir... Il faudrait alors non pas supprimer l'étiquette Suite: mais la remplacer par un End If. (Yeah !)

Si on la joue au nombre de caractères édités c'est Jean-Marie qui gagne. M... ! Comme d'hab...
 

ChTi160

XLDnaute Barbatruc
Re : Compiler Feuilles d'un meme classeur

Re
Arff je me suis dit ,si tu veux qu'il te réponde , donne lui matière Lol
Non,Non Effectivement, c'est un oubli. ;)
Content de te croiser (c'est je crois ,un ami commun @+Thierry qui n'aime pas trop les Goto :p )
Bonne journée
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Compiler Feuilles d'un meme classeur

Bonjour le fil, bonjour le forum,

Ton intervention m'a filé un sacré coup de nostalgie du temps où l'on se croisait souvent sur les posts... Ça fait du bien, merci.

Mais Jean-Marie, il faut tirer les choses au clair (comme disait mon notaire) ! Ce Thierry dont tu parles n'est pas un ami... Bien au contraire !


Ce mec m'a attrappé au tout début que je suis arrivé dans ce forum. Il pourrissait tous mes codes de débutant en les corrigeant avec une patience et un humour incroyable. Un véritable ami m'aurait dit la vérité : "Arrête ! tu n'es pas fait pour le VBA". Alors que le lui, le fan des Pierres qui Roulent, m'a montré la voie l'ignoble.

Ha ! Comme je le hais le bougre car à cause de lui je suis toujours là, à m'éclater comme un fou au lieu d'aller promener le long de la plage de Sète, et mater la gente féminine qui sort légèrement vêtue au moindre rayon de soleil... À cause de lui, j'ai découvert des gens qui, en dehors d'une passion commune, avaient du cœur et des c... Bon j'arrête là sinon il va penser que c'est un hommage...

Donc si tu as la chance de voir cet énergumène tu lui dis que je l'embrasse bien fort et qu'il manque. Sur ce, je GoTo voir le match de Rugby... Ho pardon ! L'aime pas ça le chevelu...
 

Discussions similaires

Réponses
3
Affichages
607

Statistiques des forums

Discussions
312 492
Messages
2 088 936
Membres
103 987
dernier inscrit
Doctami