Forums XLPages

Excel & VBA Espace Débutants Probleme réalisation macro avec enregistreur de macro ...

Probleme réalisation macro avec enregistreur de macro ...
#1
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 10-01-2013 13h50
 Bonjour le Forum Meilleurs à Toutes et Tous. 
Je mets en piece jointe un projet sur lequel je travaille. J'ai pas mal avancé avec l'enregistreur de macro mais je suis confronté a realiser des manips precises que je n'arrive pas a mettre en place. Mes explications se trouvent sur la feuille Février de ma piece jointe. Un exemple vaut mieux que de grands discours. 
Par avance merci de l'aide que vous m'apporterez
  Eric


Eric
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#2
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 10-01-2013 18h13
Je n'avais pas fait attention que le fichier joint n'avait pas prit ... Mais meme en enlevant un max d'infos, il pese trop lourd .... Comment puis je faire SVP ??? 
Merci d'avance
Eric
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#3
Mth
Accro XLPages

Inscription: 23/05/2008
De La Varenne Saint-Hilaire

Messages: 356

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 10-01-2013 22h32
Bonsoir Eric, bonsoir à tous,

Il n'est sans doute pas nécessaire de déposer le fichier dans son intégralité, un simple extrait de quelques lignes représentatif du problème doit suffire, fais ton possible pour alléger et zipper.
Tu pourras aussi exposer ta question dans ce fil plutôt que dans ton fichier, cela facilitera la lecture et augmentera tes chances de réponse (et allègera aussi ton fichier )

Très bonne soirée et à bientôt,

mth
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#4
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 11-01-2013 11h39
 Bonjour Mth, le forum, 
Je vous explique donc mon probleme, Normalement, le fichier est constitué d'autant de feuille que de nombre de jour dans le mois en fonction des années pour Février. Chaque feuille est récupérée dans un logiciel de gestion et  est recopiée ici a l'aide d'une macro. J'extrais les chiffres qui m'interessent dans le dernier tableau que je crée a l'aide d'une macro, et ceci sur chaque feuille du classeur ... Ensuite, je crée la feuille 1 ou tous les chiffres de chaque feuille viennent se copier... Et ce tableau récapitulatif viendra complété une base de données dans un autre classeur ... Il me reste 2 ans a réaliser et j'ai rencontré quelques petits probleme avec l'enregistreur de macro pour realiser certaines choses. Notamment, le fait de changer de feuille automatiquement, de copier un zone et de la recopier ailleurs sur la feuille de maniere a differencier le texte...   
Par avance merci ... 

Pièce jointe:
zip Point Tableaux.zip   [ Taille: 56.74 Ko - Téléchargements: 550 ]
Eric
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#5
Mth
Accro XLPages

Inscription: 23/05/2008
De La Varenne Saint-Hilaire

Messages: 356

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 13-01-2013 14h29
Bonjour Eric, bonjour le forum,

Pour ma part ta question est un peu floue, et je ne dois pas être la seule car je vois que tu n'as pas encore de réponse.

"...changer de feuille automatiquement" ... c'est à dire? une boucle sur chaque feuille?
"...copier une zone" ... laquelle?
"... la recopier ailleurs" ... où ça?
"... de manière à différencier le texte" ... c'est à dire ?

Si tu veux boucler sur tes feuilles une piste parmi d'autres:

Dim i As Long

For i = 1 To ThisWorkbook.Sheets.Count
'Sheets.count renvoie le nombre d'onglets du classeur
    If Sheets(i).Name <> "Recap" Then
    'Sheets(i).Name indique le nom de la feuille en cours
    'Si le nom de l'onglet est différent de "Recap" alors.. exécuter telle action
        'Action
    End If
Next i
 

Si non essaie d'être plus précis.

Bien à toi,

mth
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#6
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 14-01-2013 12h03
 Bonjour Mth, le forum
Désolé pour ce manque de precisions de ma part ....
Voici un autre dossier ou tout est expliqué à l'interieur ... 
En attendant je te remercie Mth et j'essais d'adapter la macro que tu m'as soumis 

 Bonne continuation 
     Eric 


Pièce jointe:
zip Point Tableaux.zip   [ Taille: 57.25 Ko - Téléchargements: 574 ]
Eric
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#7
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 14-01-2013 12h09
 Re
Désolé le probleme d'etre au boulot et de faire pleins de choses a la fois. Je souhaiterais que la macro traite chaque chaque feuille les unes apres les autres ... D'ou le fait que je vais etudier ta macro Mth de maniere a essayer de l'adapter ... 
Eric
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#8
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 15-01-2013 20h07
 Bonsoir le Forum, 
Apres avoir plenché sur mes macros et avec l(aide de la macro de Mth, que je remercie au passage, voici ce que je suis arrivé a faire. J'ai regroupé toutes les macros en une. Pour certaine je ne suis pas arrivé a les retravailler, serait il possible de les simplifiier ou tout du moins de les ecrire plus simplement afin de faciliter la relecture.
Voici donc le code:
Par avance merci de vos réponses. 

Sub Action()
'Déclaration des Variables
Dim i As Long ' Variable pour la boucle fournie par Mth site: http://www.mdf-xlpages.com/

For i = 1 To ThisWorkbook.Sheets.Count 'boucle fournie par Mth site: http://www.mdf-xlpages.com/
'Sheets.count renvoie le nombre d'onglets du classeur.
  If Sheets(i).Name <> "Recap" Then
    'Sheets(i).Name indique le nom de la feuille en cours
    'Si le nom de l'onglet est différent de "Recap" alors.. exécuter telle action
        'Action
  Worksheets(i).Activate
' Integre la formule dans la plage D14:D40 pour pouvoir différencier les cellules
' ou on retrouve Sans Tva ...par 1Sans Tva ...
Range("D14").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(OR(RC[-3]=""Sans Tva"",RC[-3]=""Tva à 19.6%"",RC[-3]=""Tva à 5.5%"",RC[-3]=""Tva à 7%"",RC[-3]=""Totaux""),""1""&RC[-3],"""")"
    Range("D14").Select
    Selection.AutoFill Destination:=Range("D14:D29"), Type:=xlFillDefault
    Range("D14:D29").Select
' Va chercher le tableau avec formule dans un autre classeur et colle le dit
'tableau dans toutes les feuilles du classeur a la meme place
Workbooks("EssaiMagKSStestfaux chiffres.xls").Sheets("BDD02").Range("A1120:D1147").Copy _
    Destination:=ActiveWorkbook.ActiveSheet.Range("A70")
   End If
     
Next i 'boucle fournie par Mth site: http://www.mdf-xlpages.com/

    Sheets("Sheet1").Select
    Range("A70").Select
'Création de la feuille Recap
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Recap"
'Copie du tableau dans la feuille Recap
Sheets("Sheet1").Range("A70:A97").Copy
    Sheets("Recap").Range("A4").Select
    ActiveSheet.Paste
'(Elaborée en cherchant avec comme base la boucle de Mth)Nomme l'intitulé des colonnes
'par le noms de chaque onglet
For i = 2 To Sheets.Count
Range("IV3").End(xlToLeft).Offset(0, 1) = Sheets(i).Name
Next i
'(A l'aide de l'enregistreur de macro)Copie des formules dans tout le tableau afin de
'pouvoir recupérer les données dans chaque feuille. Une fois terminé, recopie le
'tableau fini et ne colle au meme endroit que les valeurs
Range("B4").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4").Select
    Selection.AutoFill Destination:=Range("B4:B31"), Type:=xlFillDefault
    Range("B4:B31").Select
    ActiveWindow.SmallScroll Down:=-18
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R4C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B5").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R5C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B6").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R6C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B7").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R7C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B8").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R8C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B9").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R9C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B10").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R10C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B11").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R11C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B12").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R12C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B13").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R13C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B14").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R14C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B15").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R15C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B16").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R16C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B17").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R17C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B18").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R18C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B19").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R19C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B20").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R20C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B21").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R21C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B22").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R22C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B23").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R23C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B24").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R24C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B25").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R25C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B26").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R26C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B27").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R27C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B28").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R28C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B29").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R29C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B30").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R30C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    Range("B31").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R31C1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    Range("B4:B31").Select
    ActiveWindow.SmallScroll Down:=0
    Selection.AutoFill Destination:=Range("B4:AF31"), Type:=xlFillDefault
    Range("B4:AF31").Select
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.DisplayZeros = False
    Range("A4:AF31").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=24
    Range("B35").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    Selection.Copy
    Range("B35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'(A l'aide de l'enregistreur de macro) fait la somme des lignes et des colonnes de
'chaque tableau afin de controler que tout correspond et mise en forme
Range("B33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)"
    Range("B33").Select
    Selection.AutoFill Destination:=Range("B33:AF33"), Type:=xlFillDefault
    Range("B33:AF33").Select
    Selection.Font.Bold = True
    Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    ActiveWindow.SmallScroll ToRight:=25
    Range("AG33").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
    Range("AF33").Select
    Selection.Copy
    Range("AG33").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AG31").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
    Range("AG33").Select
    Selection.Copy
    Range("AG31").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("AG4:AG31"), Type:=xlFillDefault
    Range("AG4:AG31").Select
    ActiveWindow.SmallScroll Down:=18
    Range("AH33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-29]C[-1]:R[-2]C[-1])"
    Range("AH34").Select
    ActiveWindow.SmallScroll Down:=12
    Range("AG33").Select
    Selection.Copy
    Range("AH33").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AG34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C[1]-R[-1]C"
    Range("AD36").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-28]:RC[-1])"
    Range("AG33").Select
    Selection.Copy
    Range("AD36").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("AD36:AD66"), Type:=xlFillDefault
    Range("AD36:AD66").Select
    Range("AE68").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-32]C[-1]:R[-2]C[-1])"
    Range("AE69").Select
    ActiveWindow.SmallScroll Down:=12
    Range("AD66").Select
    Selection.Copy
    Range("B68:AE68").Select
    Range("AE68").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AE68").Select
    Range("AC68").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-32]C:R[-1]C)"
    Range("AC68").Select
    Selection.AutoFill Destination:=Range("B68:AC68"), Type:=xlFillDefault
    Range("B68:AC68").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    Range("AD68").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-28]:RC[-1])"
    Range("AD69").Select
    ActiveWindow.SmallScroll Down:=12
    ActiveCell.FormulaR1C1 = "=R[-1]C[1]-R[-1]C"
    Range("AD70").Select
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A69").Select
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 2
    ActiveCell.FormulaR1C1 = "=RC[29]-R[-35]C[32]"
    Range("A70").Select
    ActiveWindow.SmallScroll Down:=3
'A l'aide de l'enregistreur de macro
Range("A4").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=9
    Range("B35").Select
    ActiveSheet.Paste
'A l'aide de l'enregistreur de macro integre les dates dans le tableau
Range("A36").Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(VALUE(RIGHT(Sheet1!R[-28]C,LEN(Sheet1!R[-28]C)-SEARCH("" du"",Sheet1!R[-28]C)-3)),""jj/mm/aaaa"")"
    Range("A37").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("A37").Select
    Selection.AutoFill Destination:=Range("A37:A66"), Type:=xlFillDefault
    Range("A37:A66").Select
    Selection.NumberFormat = "m/d/yyyy"
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

  
Eric
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#9
Mth
Accro XLPages

Inscription: 23/05/2008
De La Varenne Saint-Hilaire

Messages: 356

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 16-01-2013 02h08
Bonsoir Eric, bonsoir à tous,

Le code généré par l'enregistreur est très pratique mais un peu indigeste, je t'avoue que je n'ai pas tout décortiqué dans le détail.
D'une façon générale une fois le code de l'enregistreur généré, il convient de le nettoyer un peu.
D'entrée tu peux éliminer tous les scroll, tu peux aussi éliminer la plupart des Select qui ne servent à rien sauf à ralentir le code.

On peut bien sûr faire mieux mais je te propose un petit nettoyage de ce genre:

Option Explicit
Sub Action()
'Déclaration des Variables
Dim i As Long ' Variable pour la boucle fournie par Mth site: http://www.mdf-xlpages.com/
Dim vImport As Variant
Dim Feuil As String
 
Feuil = "Recap"

vImport = Workbooks("EssaiMagKSStestfaux chiffres.xls").Sheets("BDD02").Range("A1120:D1147").Value

For i = 1 To ThisWorkbook.Sheets.Count 'boucle fournie par Mth site: http://www.mdf-xlpages.com/
'Sheets.count renvoie le nombre d'onglets du classeur.
  If Sheets(i).Name <> "Recap" Then
    'Sheets(i).Name indique le nom de la feuille en cours
    'Si le nom de l'onglet est différent de "Recap" alors.. exécuter telle action
        With Sheets(i)
            .Range("D14:D29").FormulaR1C1 = _
              "=IF(OR(RC[-3]=""Sans Tva"",RC[-3]=""Tva à 19.6%"",RC[-3]=""Tva à 5.5%"",RC[-3]=""Tva à 7%"",RC[-3]=""Totaux""),""1""&RC[-3],"""")"
            .Range("A70:D97") = vImport
        End With
   End If
     
Next i

'Création de la feuille Recap
'teste si Recap existe déjà, si oui ne fait rien
If Not FeuilExiste(Feuil) Then
    'cf ici: http://www.mdf-xlpages.com/modules/smartfaq/faq.php?faqid=40
    'La fonction "FeuilExiste(Feuil) décrite sur le lien est dans un module standard
    Sheets.Add before:=Sheets(1)
    ActiveSheet.Name = "Recap"
End If
'Copie du tableau dans la feuille Recap
Sheets("Sheet 1").Range("A70:A97").Copy Sheets("Recap").Range("A4")

'Nomme l'intitulé des colonnes par le noms de chaque onglet
With Sheets("Recap")
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "Recap" Then
            .Range("IV3").End(xlToLeft).Offset(0, 1) = Sheets(i).Name
        End If
    Next i
    'ajout des formules
    .Range("B4:AF31").FormulaR1C1 = _
       "=VLOOKUP(RC1,INDIRECT(R3C&""!$a$70:$c$97""),3,FALSE)"
    .Range("A4:AF31") = .Range("A4:AF31").Value
     ' etc. ...
    With .Range("B33:AF33")
        .FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)"
        .Font.Bold = True
        .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    End With
       
End With

ActiveWindow.DisplayZeros = False
End Sub
 

Sans les infos de l'onglet BDD02 du second fichier, je n'ai rien testé, par ailleurs je n'ai pas intégré toutes les formules, tu complèteras sur ton fichier, le principe est le même.

Ce n'est pas parfait mais vois si cela peut t'aider malgré tout.

Bien à toi,

mth
Hors Ligne
 Rapport   Haut 

Re: Probleme réalisation macro avec enregistreur de macro ...
#10
Eric.33
Débutant XLPages

Inscription: 19/12/2012

Messages: 13

Système d'exploitation:
PC
Version Excel utilisée:
XP 2003
Posté le : 16-01-2013 02h14
Bonsoir Mth, le forum,
Une petite insomnie ??? lol  
Je suis en train de plancher sur mes plannings alors juste un petit passage içi pour te remercier et je verrais plus en detail ce que tu m'as ecris demain .... 
Bonne nuit
Eric
Hors Ligne
 Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes