PB boucle "for each" sur quelques feuilles seulement

PB boucle "for each" sur quelques feuilles seulement - VB/VBA/VBS - Programmation

Marsh Posté le 12-09-2009 à 17:04:57    

Bonjour à tous
 
le titre est pas très clair je sais, mais je ne savais pas comment l'exprimer.
 
J'essaie de faire une macro qui permet de faire une mise à jour entre un fichier excel estampillé "ancienne version" vers le même fichier excel "estampillé "nouvelle version" (fichier identique visuellement mais avec de nouvelles macro et de nouveaux calculs)
 
Mon besoin est de pouvoir faire de nombreux copier/coller sur certaines feuilles vers les même feuilles du nouveau fichier grâce à une boucle. Voici le code qui me fait une erreur:
______________________________________________________________________________
Dim i As Worksheets
Dim mois1 As Worksheets
Dim mois2 As Worksheets
mois1 = Array("janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre" )
mois2 = Array("j", "f", "m", "a", "m1", "j1", "j2", "a1", "s", "o", "n", "d" )
 
For Each i In mois1
   Worksheets(i).Select
   Range("J4:M34" ).Select
   Selection.ClearContents
Next i
 
For Each i In mois2
Windows(nomfichiersuivant).Activate
    Sheets(i).Select
    Range("B29:E29" ).Select
    Selection.Copy
Windows(NomCeFichier).Activate
    Sheets(i).Select
    Range("B29:E29" ).Select
    ActiveSheet.Paste
Windows(nomfichiersuivant).Activate
    Sheets(i).Select
    Range("AB28:AD28" ).Select
    Application.CutCopyMode = False
    Selection.Copy
Windows(NomCeFichier).Activate
    Sheets(i).Select
    Range("AB28:AD28" ).Select
    ActiveSheet.Paste
Next i
 
For Each i In mois1
 Windows(nomfichiersuivant).Activate
 Worksheets(i).Select
  Range("J4:M34" ).Select
  Selection.Copy
 Windows(NomCeFichier).Activate
  Worksheets(i).Select
  Range("J4" ).Select
  ActiveSheet.Paste
 Windows(nomfichiersuivant).Activate
  Worksheets(i).Select
  Range("D4:G34" ).Select
  Selection.Copy
 Windows(NomCeFichier).Activate
  Worksheets(i).Select
  Range("d4" ).Select
  ActiveSheet.Paste
Next i
________________________________________________________________________________
 
 
Avec ces différents copier, j'ai un autre problème qui apparait:
 
certaines plage (que ce soit dans le fichier "ancienne version" que dans celui "nouvelle version, puisqu'ils sont identiques; seul le fichier nouvelle version est vierge de toutes données, je reprécise), donc certaine plages contiennent des noms de listes de validation.
 
Forcément lorsque je veux coller, j'ai un message d'excel qui me demande si je veux bien garder le même nom de définition ou le changer.
 
Dans mon cas, je veux garder le même nom...mais je ne sais pas comment l'intégrer dans la macro automatiquement.
 
Désolé pour la longueur
 
Merci d'avance pour votre aide.


---------------
SuRgEoN
Reply

Marsh Posté le 12-09-2009 à 17:04:57   

Reply

Marsh Posté le 12-09-2009 à 18:08:44    

Salut, commence par un code correct , lisible et propre, on verra pour la suite, à toi de le tester

Option Explicit
 
Sub Tst()
Dim i As Integer
Dim mois1 As Variant
Dim mois2 As Variant
Dim nomfichiersuivant As String
Dim NomCeFichier As String
 
    mois1 = Array("janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre" )
    mois2 = Array("j", "f", "m", "a", "m1", "j1", "j2", "a1", "s", "o", "n", "d" )
 
    nomfichiersuivant = "?????"
    NomCeFichier = "?????"
     
    Application.ScreenUpdating = False
     
    For i = LBound(mois1) To UBound(mois1)
        Worksheets(i + 1).Range("J4:M34" ).ClearContents
    Next i
 
    For i = LBound(mois2) To UBound(mois2)
        Windows(nomfichiersuivant).Sheets(i).Range("B29:E29" ).Copy
        Windows(NomCeFichier).Sheets(i).Range("B29" ).Paste
        ' ..... etc
    Next i
 
    For i = LBound(mois1) To UBound(mois1)
        Windows(nomfichiersuivant).Activate
        Worksheets(i + 1).Range("J4:M34" ).Copy
         
        Windows(NomCeFichier).Worksheets(i).Range("J4" ).Paste
        ' ..... etc
    Next i
     
    Application.ScreenUpdating = True
End Sub


PS: Le balisage du code n'est pas interdit  : Sélectionner le code puis clic sur Icône "Fixe"


Message édité par kiki29 le 12-09-2009 à 18:19:29
Reply

Marsh Posté le 12-09-2009 à 18:33:43    

Hello
 
Merci beaucoup pour ta réponse  
 
Ayant cherché encore et avec ta solution j'ai mixé car j'avais des messages d'erreurs avec ces types de lignes:
 
 


...
Windows(NomCeFichier).Sheets(i).Range("B29" ).Paste  
...

 
 
Du coup ça donne ça et ça marche ...sauf le souci évoqué en fin de mon premier post : les cellules contenant un "nom" existant que je souhaite d'office écraser ou réutiliser, en tout cas, je veux éviter d'avoir à cliquer sur oui 25 fois (je les ai comptés...)
 
 
 


Sub évolution()
mois1 = Array("janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre" )
mois2 = Array("j", "f", "m", "a", "m1", "j1", "j2", "a1", "s", "o", "n", "d" )
 
 
'   Suppression de données
'******************************************************
For Each i In mois1
   Worksheets(i).Range("J4:M34" ).ClearContents
   Worksheets(i).Range("D4:G34" ).ClearContents
Next i
 
'   Recopie de l'ancien fichier vers le nouveau
'******************************************************
Application.StatusBar = True
Application.ScreenUpdating = False
 
For Each i In mois2
  Windows(nomfichiersuivant).Activate
    Worksheets(i).Range("B29:E29" ).Copy
  Windows(NomCeFichier).Activate
    Worksheets(i).Select
    Range("B29:E29" ).Select
    ActiveSheet.Paste
  Windows(nomfichiersuivant).Activate
    Worksheets(i).Range("AB28:AD28" ).Copy
  Windows(NomCeFichier).Activate
    Worksheets(i).Select
    Range("AB28:AD28" ).Select
    ActiveSheet.Paste
Next i
 
For Each i In mois1
 Windows(nomfichiersuivant).Activate
 Worksheets(i).Range("J4:M34" ).Copy
 Windows(NomCeFichier).Activate
  Worksheets(i).Select
  Range("J4" ).Select
  ActiveSheet.Paste
 Windows(nomfichiersuivant).Activate
  Worksheets(i).Range("D4:G34" ).Copy
 Windows(NomCeFichier).Activate
  Worksheets(i).Select
  Range("d4" ).Select
  ActiveSheet.Paste
Next i


 
merci encore pour ta réponse


---------------
SuRgEoN
Reply

Marsh Posté le 12-09-2009 à 19:29:07    

Re, peut-être via


Application.DisplayAlerts = False
.....
Application.DisplayAlerts = True


 
Tu dois pouvoir réduire certains codes du type


    Worksheets(i).Select  
    Range("AB28:AD28" ).Select  
    ActiveSheet.Paste


en

Worksheets(i).Range("AB28" ).Paste


 
2 utilitaires qui pourraient t'être utile http://www.oaltd.co.uk/Indenter/Default.htm
et la version VBA http://www.mztools.com/v3/download.aspx


Message édité par kiki29 le 12-09-2009 à 19:38:08
Reply

Marsh Posté le 12-09-2009 à 21:34:56    

Excellent!!!
 
vraiment un grand merci
 


Application.DisplayAlerts = False  
.....  
Application.DisplayAlerts = True  


Ca a marché je n'ai plus de message à cliquer
 
Pour les outils je regarderai volontiers!!!
 
Enfin pour cette ligne:


Worksheets(i).Range("AB28" ).Paste

ça me met une erreur, alors j'ai gardé la version longue.
 
Merci encore


---------------
SuRgEoN
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed