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

Dranreb

XLDnaute Barbatruc

• 27 Octobre 2019

• #2

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

 

Vote positif 0 Vote négatif

didier09

XLDnaute Occasionnel

• 27 Octobre 2019

• #3

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

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 27 Octobre 2019

• #4

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

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 27 Octobre 2019

• #5

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…

VB:

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

 

Dernière édition: 27 Octobre 2019

Vote positif 0 Vote négatif

didier09

XLDnaute Occasionnel

• 27 Octobre 2019

• #6

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

 

Vote positif 0 Vote négatif

didier09

XLDnaute Occasionnel

• 27 Octobre 2019

• #7

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.

VB:

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

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 27 Octobre 2019

• #8

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

 

Vote positif 0 Vote négatif

didier09

XLDnaute Occasionnel

• 27 Octobre 2019

• #9

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

 

Vote positif 0 Vote négatif

didier09

XLDnaute Occasionnel

• 28 Octobre 2019

• #10

Bonsoir le fil,

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

Bonne soirée
Didier

 

Vote positif 0 Vote négatif