Discussion :

[Seth2]

Bonsoir,

J'ai un peu de mal à résoudre un problème :

En fait je dispose de plusieurs classeurs Excel de type "A" et "B". Ces deux classeurs regroupent plusieurs feuilles portant les mêmes noms, c'est à dire que A et B contiennent des feuilles semblables, seules les données sur ces feuilles changent.

1) Je cherche maintenant à faire une Macro qui regroupe les feuilles de "A" et "B" portant les mêmes noms dans un seul classeur, et donc créer autant de classeurs que de noms de feuilles existants => 1 classeur par nom; la 1ère feuille de ce classeur contiendra celle issue de A, et la 2ème celle issue de B.

J'ai essayé d'appliquer la Macro trouvée ici : https://msdn.microsoft.com/fr-fr/lib...ffice.14).aspx , mais je bloque un peu dans la partie de la boucle pour comparer les noms des Worksheets:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Sub extractiondonnees()
 
   Dim sSource As String
   Dim ws As Worksheet
   Dim wb As Workbook
   Dim SummarySheet As Worksheet
   Dim FolderPath As String
   Dim SelectedFiles() As Variant
   Dim NRow As Long
   Dim FileName As String
   Dim NFile As Long
   Dim WorkBk As Workbook
   Dim SourceRange As Range
   Dim DestRange As Range
   Dim LastRow As Long
 
 
   Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
 
   SelectedFiles = Application.GetOpenFilename(, , "Fichiers Sources", , True)
 
   If SelectedFiles = "False" Then
      Exit Sub
   End If
 
   NRow = 1
 
   For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
 
        FileName = SelectedFiles(NFile)
 
 
        Set WorkBk = Workbooks.Open(FileName)
 
 
        SummarySheet.Range("A" & NRow).Value = FileName
 
        LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
                 After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
                 SearchDirection:=xlPrevious, _
                 LookIn:=xlFormulas, _
                 SearchOrder:=xlByRows).Row
        Set SourceRange = WorkBk.Worksheets(1).Range("A1:S" & LastRow)
 
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
 
 
        DestRange.Value = SourceRange.Value
 
        NRow = NRow + DestRange.Rows.Count
 
        WorkBk.Close savechanges:=False
    Next NFile
 
    SummarySheet.Columns.AutoFit
 
End Sub

Je ne sais pas comment parcourir les deux Workbooks en même temps :/

2) Si par exemple je dois copier les données présentes dans ces feuilles en les comparant à des valeurs précises (des normes), comment pourrais-je y procéder ?
Les valeurs respectant les normes se copieront normalement, et les données "erronées" seront aussi copiées mais leurs cellules de destination seront de couleur rouge.

Merci d'avance !

[Philippe Tulliez]

Bonjour,
Les fichiers à télécharger dès l'ouverture d'une discussion ne sont pas les bienvenus.
La procédure que tu trouveras dans cette contribution nommée Regrouper plusieurs feuilles sur une autre. (2003-2010) devrait répondre à ton attente.

[Seth2]

Merci pour votre réponse rapide Philippe. Je vais retirer les pièces jointes.
A propos de la procédure que vous avez créé, est-il possible de l'affecter à un bouton ? Désolé je ne me suis pas encore familiarisé avec les fonctions :/

[Philippe Tulliez]

Bonjour,

A propos de la procédure que vous avez créé, est-il possible de l'affecter à un bouton ?

Voir le classeur à télécharger qui se trouve dans la contribution.