Pbm Boucle For Each sur plusieurs onglet

WaxistSelecta · 29 Juillet 2010

Bonjour le fil,

je travaille sur une boucle 'For Each' qui ne fonctionne pas exactement comme je le souhaite... J'ai fais des recherches sur le fil et sur google pour voir si je trouvais une solution mais sans succès...

Je l'ai écrite tout seul et n'étant pas très calé en VB, il se peut qu'elle soit bancale (c'est fort probable).

Voila ce qu'elle est censé faire:
J'ai un classeur avec environ 29 + 1 onglets
Je souhaite, pour chaque onglet présent dans le classeur, réaliser un copier coller des données vers un autre doc (qui est un template) et renommer ce doc avec la valeur d'une cellule. Puis passer à l'onglet suivant.

Je joins mon code si qqun peut me dire ce qui cloche:

Sub CreaReportLoop()

'Dim Sh As Worksheet
'Dim Wkb As Workbook

'Dim chemin As String, fichier As String
'chemin = ThisWorkbook.Path
'fichier = chemin & "\" & Range("B7") & ".xls"

Application.ScreenUpdating = False

For Each Worksheet In ThisWorkbook.Worksheets
'Boucle sur chaque feuille de chaque classeur
Workbooks("Copy of Consolidation par semaine_Test_V2.xls").Worksheets
Range("A2:L36").Select
Selection.Copy
Workbooks.Open ("C:\Templates\Template Report Région.xls")
ActiveWorkbook.Sheets("Votre Région a Date").Range("A7").Activate
'Selection.Paste
Selection.PasteSpecial xlPasteValues
ActiveWorkbook.SaveAs Filename:=Range("B7")
ActiveWorkbook.Close

Next Worksheet
End Sub

Merci d'avance si qqun peut m'aider!

WaxistSelecta · 3 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Re,

le message dit
"run time error '1004'
Methode 'Save As' of object '_Workbook' failed"

En gros, ce que je cherche à faire c'est:
- Ouvrir le fichier template
- Coller les données de 1 dans le template / onglet "Votre Région à Date"
- Coller les données de 1H dans le template / onglet "Votre Région Histo"
- Sauvegarder sous / valeur de "Votre Région à Date".Range("A1")

PUIS
- idem pour les données de 2 & 2H, 3 & 3H, ... X & XH

Désolé je suis un peu un boulet en vba mais je m'efforce d'apprendre

Pierrot93 · 3 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Re,

et qu'y a t il en A1, c'est un nom de fichier valide ??? et le classeur n'existe pas déjà ? mets la totalité du code utilisé....

WaxistSelecta · 3 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Bon boulet je suis boulet je reste
A1 c'est une erreur de ma pars, il fallait mettre B7 en fait...

Voici mon code plus bas... Par contre, ca génère 2 fichiers par région et non pas un seul
=> 1 fichier "1" et 1 fichier "1H"
=> 1 fichier "2" et 1 fichier "2h" etc...

Sub BoucleTotale()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Génération des onglets "A Date" et "Historique" en utilisant le fichier template '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False

Dim Sh As Worksheet, wb As Workbook

'Boucle passant sur chacun des onglets régions pour créer un report indépendants

For Each Sh In ThisWorkbook.Worksheets

If Sh.Name <> "Conso à date par région" And Sh.Name <> "Conso histo par région" Then
Set wb = Workbooks.Open("C:\Templates\Template Report Région.xls")
If IsNumeric(ActiveSheet.Name) Then
Sh.Range("A2:G36").Copy Destination:=wb.Sheets("Votre Région a date").Range("A65536").End(xlUp)(2)
Sh.Range("H2:H36").Copy Destination:=wb.Sheets("Votre Région a date").Range("J65536").End(xlUp)(2)
Sh.Range("I2:I36").Copy Destination:=wb.Sheets("Votre Région a date").Range("M65536").End(xlUp)(2)
Sh.Range("J2:J36").Copy Destination:=wb.Sheets("Votre Région a date").Range("P65536").End(xlUp)(2)
Sh.Range("K2:K36").Copy Destination:=wb.Sheets("Votre Région a date").Range("S65536").End(xlUp)(2)
Sh.Range("L2:L36").Copy Destination:=wb.Sheets("Votre Région a date").Range("V65536").End(xlUp)(2)
Sh.Range("M2:M36").Copy Destination:=wb.Sheets("Votre Région a date").Range("Y65536").End(xlUp)(2)
Sh.Range("N2:N36").Copy Destination:=wb.Sheets("Votre Région a date").Range("AB65536").End(xlUp)(2)
'NB : Copie des données à compléter ou à rendre dynamique (sans déclarer les colonnes)

With Sh

'Mise en forme du report régional

Range("A7:G50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Range("J7:AS50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

End With

Else
Sh.Range("A2:G36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("A65536").End(xlUp)(2)
Sh.Range("H2:H36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("J65536").End(xlUp)(2)
Sh.Range("I2:I36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("M65536").End(xlUp)(2)
Sh.Range("J2:J36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("P65536").End(xlUp)(2)
Sh.Range("K2:K36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("S65536").End(xlUp)(2)
Sh.Range("L2:L36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("V65536").End(xlUp)(2)
Sh.Range("M2:M36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("Y65536").End(xlUp)(2)
Sh.Range("N2:N36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("AB65536").End(xlUp)(2)

With Sh

'Mise en forme du report régional

Range("A7:G50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Range("J7:AS50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

End With

End If

With wb
wb.SaveAs ("C:\Templates\" & Range("B7").Value & ".xls")
wb.Close
End With

End If

Next Sh

MsgBox "Les Fichiers de Reporting Hebdomadaires ont été générés."

End Sub

Pierrot93 · 3 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Et en B7 le nom du fichier, est un nom valide pour un fichier ? et attention, c'est la valeur de la cellule B7 de la feuille active lors de l'enregistrement qui est prise en compte.....

Pierrot93 · 4 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Bonjour,

ci-dessous, ci-dessous uniquement le code concernant la boucle, teste le en l'état et dis moi si cela fonctionne comme tu veux, mais attention il me semble que le nom du nouveau classeur sera toujours pris sur la même cellule B7, de la même feuille du même classeur.........

Code:

Option Explicit
Sub BoucleTotale()
Dim Sh As Worksheet, wb As Workbook
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Conso à date par région" And Sh.Name <> "Conso histo par région" Then
        Set wb = Workbooks.Open("C:\Templates\Template Report Région.xls")
        If IsNumeric(ActiveSheet.Name) Then
            Sh.Range("A2:G36").Copy Destination:=wb.Sheets("Votre Région a date").Range("A65536").End(xlUp)(2)
            Sh.Range("H2:H36").Copy Destination:=wb.Sheets("Votre Région a date").Range("J65536").End(xlUp)(2)
            Sh.Range("I2:I36").Copy Destination:=wb.Sheets("Votre Région a date").Range("M65536").End(xlUp)(2)
            Sh.Range("J2:J36").Copy Destination:=wb.Sheets("Votre Région a date").Range("P65536").End(xlUp)(2)
            Sh.Range("K2:K36").Copy Destination:=wb.Sheets("Votre Région a date").Range("S65536").End(xlUp)(2)
            Sh.Range("L2:L36").Copy Destination:=wb.Sheets("Votre Région a date").Range("V65536").End(xlUp)(2)
            Sh.Range("M2:M36").Copy Destination:=wb.Sheets("Votre Région a date").Range("Y65536").End(xlUp)(2)
            Sh.Range("N2:N36").Copy Destination:=wb.Sheets("Votre Région a date").Range("AB65536").End(xlUp)(2)
        Else
            Sh.Range("A2:G36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("A65536").End(xlUp)(2)
            Sh.Range("H2:H36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("J65536").End(xlUp)(2)
            Sh.Range("I2:I36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("M65536").End(xlUp)(2)
            Sh.Range("J2:J36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("P65536").End(xlUp)(2)
            Sh.Range("K2:K36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("S65536").End(xlUp)(2)
            Sh.Range("L2:L36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("V65536").End(xlUp)(2)
            Sh.Range("M2:M36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("Y65536").End(xlUp)(2)
            Sh.Range("N2:N36").Copy Destination:=wb.Sheets("Votre Région Histo").Range("AB65536").End(xlUp)(2)
        End If
        With wb
            .SaveAs ("C:\Templates\" & [COLOR="Red"][B]Workbooks("nomclasseur.xls").Sheets("nomfeuille").Range("B7").Value & ".xls")[/B][/COLOR]            
            .Close
        End With
    End If
Next Sh
End Sub

A noter, dans ton code des bloc "with" non utilisés.....

bonne journée
@+

WaxistSelecta · 4 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Salut Pierrot,

merci pour ton aide. Je teste ton code dans la matinée et je te dis ce qu'il en est.

Pour répondre à ta question, oui effectivement en B7 c'est une valeur correcte pour sauvegarder le fichier.

Merci!

@ +

Julien

WaxistSelecta · 4 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Re,

En fait cela ne fonctionne pas exactement comme le résultat attendu…

Comme je te disais, il y a un problème avec la méthode SAVE
.SaveAs ("C:\Templates\" & Workbooks("Template Report Région.xls").Sheets("Votre Région a date").Range("B7").Value & ".xls")
.Close

J’ai 2 classeurs :
- Le classeur contenant la boucle (fichier source)
- Le classeur Template (fichier cible)

En effet, mon classeur est composé de X onglets
- 1 premiers onglet « Conso à date »
- 1 deuxième onglet « Conso Histo »
- 29 onglets nommés 1, 2, 3 ….X qui sont des tris sur critère (par région) collés dans un onglet indépendant depuis l’onglet « Conso à Date »
- 29 onglets nommés 1H, 2H, … XH qui sont également des tris sur critères (par région) collés dans un onglet indépendant depuis l’onglet « Conso Histo »
 Elle doit donc créer 29 fichiers en tout

NB : les chiffres 1, 2, 3 etc… sont des identifiants pour chacune des régions que je traite

Ma boucle est censée faire la chose suivante :
- Ouvrir le fichier template
- Copier/Coller l’onglet 1 du fichier source vers le template dans l’onglet «Votre région a Date »
- Copier / Coller l’onglet 1H du fichier source vers le template, onglet « Votre région Histo »
- Sauvegarder en utilisant la cellule B7
- Fermer le fichier et recommencer pour les onglets 2 & 2H, 3 & 3H etc…répétant ainsi l’opération pour les 29 régions.

Le résultat obtenu actuel n’est pas conforme car la boucle fait la chose suivante :
- La boucle se lance
- Le premier onglet qu’elle rencontre est « 1H », du coup elle ouvre le template et va directement coller les données dans l’onglet « Votre Région Histo »
(elle passe tout de suite au Else dans le code)
- Elle essaie de faire un SAVE qui se base sur l’onglet « Votre Région à Date » qui du coup est vide

Je ne sais pas si ce que je dit est clair

Si besoin, je peux joindre un/des fichiers illustratifs du résultat attendu

Cdt

Pierrot93 · 4 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Re,

donc la boucle fonctionne bien et créée les classeurs qu'il faut, a priori ce sont les données copiées qui ne vont pas... exécute le code pas à pas, tout en adaptant simultanément tes noms d'onglets et plages copiées.... perso sans fichier et sans tout comprendre peux plus grand chose pour toi....

WaxistSelecta · 4 Août 2010

Re : Pbm Boucle For Each sur plusieurs onglet

Re,

oui la boucle fonctionne techniquement... Merci pour ton aide sur ce coup.

Je vais essayer d'adapter le truc pour parvenir au résultat attendu.

Bonne journée

J.

Pbm Boucle For Each sur plusieurs onglet

WaxistSelecta

XLDnaute Junior

WaxistSelecta

XLDnaute Junior

Pierrot93

XLDnaute Barbatruc

WaxistSelecta

XLDnaute Junior

Pierrot93

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

WaxistSelecta

XLDnaute Junior

WaxistSelecta

XLDnaute Junior

Pierrot93

XLDnaute Barbatruc

WaxistSelecta

XLDnaute Junior

Discussions similaires