Copier plusieurs feuilles de plusieurs classeurs

[nonoTT]

Bonjour le forum
Je recherche à copier une feuille de chaque classeur situé dans un même dossier.
J'ai la macro suivante récupérer sur le net qui permet de sélectionner les feuilles à copier à partir d'un classeur ouvert dans un classeur synthèse déjà ouvert.

Comment faire par macro pour :
- sélectionner le classeur excel à traiter à l'aide du mois : les classeurs ont un nom de la forme Recap-site-mois.xlsx
- sélectionner dans chacun des classeurs la feuille désirée par exemple "Biochimie"
- Sélectionner , copier le tableau de chaque feuille biochimie et le coller dans la feuille synthèse les uns à la suite des autres

Un exemple valant mieux que de longues explications, vous trouverez ci joint :
- la macro
- 2 exemples de fichier de départ
- 1 exemple de fichier synthèse voulu

Merci à vous de m'aider

la macro

Sub CopieDeFeuillesChoisies()
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim i As Byte, ListeACopier '(as variant)
Dim Ok As Boolean
    Set CL1 = Workbooks("Recap VO EEQ-avril-12.xlsx")
    Set CL2 = Workbooks("synthese EEQ.xlsx")
    'ListeACopier = Array("Feuil1", "Feuil3", "Feuil7")
For Each LaFeuille In CL1.Worksheets
       If MsgBox("Copier la feuille " & LaFeuille.Name, vbYesNo) = vbYes Then _
            LaFeuille.Copy After:=CL2.Worksheets(CL2.Worksheets.Count)
    Next
    
   '     If Ok Then LaFeuille.Copy After:=CL2.Worksheets(CL2.Worksheets.Count)
   '     Ok = False
  '  Next
    Set CL1 = Nothing
    Set CL2 = Nothing
End Sub

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Bonjour nonoTT,

Les tableaux à copier ont une hauteur constante (7), alors c'est simple :

Sub CopierFichiers()
Dim t As String, F As Worksheet, lig As Long, i As Byte, mois As String
Application.ScreenUpdating = False
t = ThisWorkbook.Path & "\Recap-site-" 'chemin à adapter éventuellement
Set F = ActiveSheet
lig = 2 '1ère ligne de copie
F.[A2:O85].Delete xlUp 'RAZ
For i = 1 To 12 'n° des mois
  mois = Format(CDate(1 & "/" & i), "mmmm")
  On Error Resume Next 'si le fichier n'existe pas
  With Workbooks.Open(t & mois & ".xlsx")
    .Sheets("Biochimie").[A5:O11].Copy F.Cells(lig, 1)
    .Close
  End With
  If Err = 0 Then lig = lig + 7
Next
End Sub

Les fichier sont supposés dans le même dossier que le fichier synthese.

Si ce n'est pas le cas écrire leur chemin d'accès complet.

Fichier .xlsm joint avec la macro dans Module1 (Alt+F11).

Edit : ajouté F.[A2:O85].Delete xlUp 'RAZ

A+

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Re,

Peut-être serait-il bon d'indiquer le mois en colonne A :

If Err = 0 Then
  F.Cells(lig, 1) = Application.Proper(mois)
  F.Cells(lig, 1).Font.Bold = True 'gras
  lig = lig + 7
End If

A+

 

[nonoTT]

Re : Copier plusieurs feuilles de plusieurs classeurs

Bonjour
La macro fonctionne mais pas de manière satisfaisante. Actuellement j'ai 5 mois de données (avril, mai, juin, juillet, aout). En éxécutant la macro je n'ai que les résultats d'aout ?
voir résultat ci-joint
Ce que j'ai peut être oublié de dire c'est que les classeurs à copier ne font pas le même nombre de lignes, comment intégrer cette données dans la macro, j'avais songé à la chose suivante mais c'est encore pire, elle ne copie rien du tout.

Option Explicit

Sub CopierFichiers()
Dim t As String, F As Worksheet, lig, derlig, derlig2 As Long, i As Byte, mois As String
Application.ScreenUpdating = False
t = ThisWorkbook.Path & "\Recap VO EEQ-" 'chemin à adapter éventuellement

Set F = ActiveSheet
lig = 2 '1ère ligne de copie
F.[A2:O85].Delete xlUp 'RAZ
For i = 1 To 12 'n° des mois
  mois = Format(CDate(1 & "/" & i), "mmmm")
  On Error Resume Next 'si le fichier n'existe pas
  With Workbooks.Open(t & mois & "-12.xlsx")
    derlig = .Sheets("Biochimie").Range("A65526").End(xlUp).Row
    .Sheets("Biochimie").[A5:O" & derlig"].Copy F.Cells(lig, 1)
    .Close
  End With
  If Err = 0 Then
  derlig2 = F.Range("A65526").End(xlUp).Row
  lig = lig + derlig - 1
End If
Next

End Sub

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Bonjour nonoTT,

Eh bien déposez vos 5 fichiers avril mai juin juillet août sur le fil (il faut l'accent sur août).

Avec donc des hauteurs de tableaux différentes.

La solution de mon post #3 ne vous intéresse pas ?

A+

 

[nonoTT]

Re : Copier plusieurs feuilles de plusieurs classeurs

ci joint les fichiers demandés.
Je n'ai pas ben compris votre message concernant les mois.

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Re,

Merci pour les fichiers, il manque le mois d'août...

Deux fichiers synthese, sans et avec le mois du fichier copié.

A+

 

[nonoTT]

Re : Copier plusieurs feuilles de plusieurs classeurs

Voici les résultats obtenus. Le problème est qu'il manque des lignes de résultats.
j'envoie le résultats obtenu et ce qu'il aurait fallu obtenir.
Cordialement.

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Re,

Avec le mois affiché on voit les lignes copiées pour chaque mois.

Et sur mon fichier joint les lignes des fichiers de votre post #6 sont toutes copiées

Je ne peux rien faire de plus...

A+

 

[nonoTT]

Re : Copier plusieurs feuilles de plusieurs classeurs

Bonjour
Voila ce que j'obtiens :
Bizarre ?

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Bonjour nonoTT,

Oui, surtout que les mois devraient être affichés en colonne A

Vérifiez dans les feuilles mois que le filtre automatique est bien désactivé...

A+

 

[nonoTT]

Re : Copier plusieurs feuilles de plusieurs classeurs

Je crois que j'ai la réponse à ta question, en effet ils sont activés. je fais le test sans et je reposte.
Il n'y a pas moyen de les desactiver via la macro ?
Cordialement.

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Re,

Il n'y a pas moyen de les desactiver via la macro ?

Bien sûr que si :

With Workbooks.Open(t & mois & "-12.xlsx")
  .Sheets("Biochimie").AutoFilterMode = False 'désactive le filtre
'---suite

Mais normalement quand on utilise un filtre dans une feuille on le désactive avant de fermer le fichier.

Surtout quand on veut copier les feuilles ensuite par macro...

En effet End(xlUp) donne un mauvais résultat quand des lignes sont masquées.

A+

 

[nonoTT]

Re : Copier plusieurs feuilles de plusieurs classeurs

Même en désactivant les filtres je n'ai pas mieux.
voir fichier joint

 

[job75]

Re : Copier plusieurs feuilles de plusieurs classeurs

Re,

Ah mais oui !! Je me souviens maintenant que Jacques Boisgontier m'avait signalé ceci :

Sur certaines versions Excel On Error Resume Next ne redonne pas à l'objet Err la valeur 0.

Alors je pense que ces fichiers (2) devraient vous convenir.

A+