Titre du sujet : Re: Probleme réalisation macro avec enregistreur de macro ...
par Mth le 16/01/2013 02:08:45
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
|
Didier FOURGEOT