XL 2016 Récupérer un onglet de plusieurs fichier dans un autre fichier récap

[didier09]

Bonjour le forum,

Je reviens vers vous pour de l'aide. je n'arrive pas à adapter un code (Code de M. Boigontier) à mon besoin.

Je dois récupérer un onglet d'un fichier mensuel pour faire un récap annuel dans un autre fichier (10 ans d'archives)

Je travaille sur cette macro:

Sub consolide()
 
Sub consolide()
  ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook
  sup
  compteur = 1
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
      Workbooks.Open Filename:=nf
      Sheets("ET").Select
      ActiveSheet.Unprotect
      Sheets("ET").Copy
      ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      ActiveWorkbook.Activate
      Sheets.Add After:=ActiveSheet
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
      'For k = 1 To Sheets.Count
        'Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)
        'classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = "ET" & compteur
        'compteur = compteur + 1
      'Next k
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
End Sub
End Sub

Les feuilles sont protégées par mot de passe : OK

Merci pour vos retours.
Didier

 

[Dranreb]

Bonjour.
Pourquoi n'avez vous pas gardé une partie du code en commentaire ?
ActiveSheet.Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)

Remarque: j'aurais pris un non plus court pour le classeur plutôt cible que maître : WkbCbl

 

[didier09]

Bonjour Dranreb,

merci de votre aide;

De ce que j'en comprends ce code était fait pour récupérer tous les onglets d'un classeur, je souhaite récupérer seulement l'onglet "ET" pour ma synthèse. (Mon niveau est débutant en VBA)

Pour la seconde remarque je ne comprends pas ?

Didier

 

[Dranreb]

Mais vous avez fait un Select de cet onglet (ce que je n'aurais d'ailleurs pas fait) c'est donc devenu ActiveSheet.

 

[Dranreb]

En fait je crois comprendre à divers indices que ce ne sont pas les feuilles que vous voulez copier mais les valeurs de leurs cellules.
Or vous ne faites nulle part de LaPlageDeCellule.Copy, alors qu'espérez vous d'un Selection.PasteSpecial Paste:=xlPasteValues ?

Spoiler: Si vous ne souhaitez plus chercher, ou alors différemment…

Sub Consolide()
   Dim WbkCbl As Workbook, WshCbl As Worksheet, NF As String, WbkSrc As Workbook, WshSrc As Worksheet
   Set WbkCbl = ActiveWorkbook
   Set WshCbl = WbkCbl.Sheets(WbkCbl.Sheets.Count)
   ChDrive WbkCbl.Path: ChDir WbkCbl.Path
   NF = Dir("*.xls")
   Do While NF <> ""
      If NF <> WbkCbl.Name Then
         Set WbkSrc = Workbooks.Open(Filename:=NF)
         Set WshSrc = WbkSrc.Worksheets("ET")
         WshSrc.Unprotect Password:="OK"
         WbkCbl.Sheets.Add After:=WshCbl
         Set WshCbl = WbkCbl.Sheets(WbkCbl.Sheets.Count)
         With WshSrc.UsedRange
            WshCbl.Cells(1, 1).Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
         WbkSrc.Close SaveChanges:=False
         End If
      NF = Dir: Loop
   End Sub

 

[didier09]

Ce sont bien tous les onglets ayant pour nom "ET" que je souhaite récupérer (Dans le répertoire à considérer, douze fichiers mois où je veux récupérer les onglets ET, puis les insérer à la suite dans mon fichier synthèse.

"alors qu'espérez vous d'un Selection.PasteSpecial Paste:=xlPasteValues" >>> Je souhaite copier seulement les valeurs sans les formules.

J’espère être assez clair.

Didier

 

[didier09]

Bonsoir,

J"ai finalement trouvé une solution par macro qui me permet de récupérer mes données. Je vous joins le code ci dessous, ça peut servir à d'autre en adaptant un peu le code.

Sub consolide()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook
  compteur = 1
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
      Workbooks.Open Filename:=nf
      Sheets("ET").Select
      ActiveSheet.Unprotect ("ok")
      Cells.Select
      Selection.Copy
      classeurMaitre.Activate
      Sheets.Add After:=ActiveSheet
      Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                           xlNone, SkipBlanks:=False, Transpose:=False
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
End Sub

Merci pour le temps consacré à mon problème, bonne soirée
Didier

 

[Dranreb]

Ma procédure mise en Spoiler est légèrement plus concise, mais fait la même chose, non ?

 

[didier09]

Désolé Dranreb j'ai pas déroulé le bandeau...J'essaie la macro demain, je suis sur la tablette.
Je vous fais un retour. Encore merci pour votre disponibilité.

Didier

 

[didier09]

Bonsoir le fil,

La procédure de Dranreb fonctionne aussi. Merci. J'ai plus qu'à bosser maintenant...

Bonne soirée
Didier