Problème avec une macro enregistré

Le 22/05/2010 à 12:20

Bonjour,

J'ai 24 tableaux identiques, et je dois faire toute une série de manipulations redondantes. j'ai donc décidé d'enregistrer une macro.

Mais quant je la transpose au autres tableau il y a un décalage qui s'oppère au niveau de passage 3, j'aurais voulus savoir s'il était possible d'arranger ca, ne connaissant pas le langage visual basic je ne peut rien faire, voici la macro:

Sub Macro2()

'

' Macro2 Macro

'

'

Columns("D:D").Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A3:W10").Select

ActiveWindow.SmallScroll Down:=-18

ActiveWindow.SmallScroll ToRight:=-10

Range("A2:AC74").Select

ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A2:A74") _

, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Feuil1").Sort

.SetRange Range("A2:AC74")

.Header = xlGuess

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Range("D2").Select

ActiveCell.FormulaR1C1 = "=SUM(RC[-2])"

Range("D18").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-15]C[-2]:RC[-2])"

ActiveWindow.SmallScroll Down:=15

Range("D34").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-15]C[-2]:RC[-2])"

Selection.AutoFill Destination:=Range("D34:D36"), Type:=xlFillDefault

Range("D34:D36").Select

ActiveWindow.SmallScroll Down:=15

Range("D45").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-8]C[-2]:RC[-2])"

ActiveWindow.SmallScroll Down:=9

Range("D53").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-7]C[-2]:RC[-2])"

ActiveWindow.SmallScroll Down:=12

Range("D73").Select

ActiveWindow.SmallScroll Down:=-6

ActiveCell.FormulaR1C1 = "=SUM(R[-19]C[-1]:RC[-1])"

Selection.AutoFill Destination:=Range("D73:E73"), Type:=xlFillDefault

Range("D73:E73").Select

ActiveWindow.SmallScroll Down:=-6

Range("D53").Select

Selection.AutoFill Destination:=Range("D53:E53"), Type:=xlFillDefault

Range("D53:E53").Select

ActiveWindow.SmallScroll Down:=-15

Range("D45").Select

Selection.AutoFill Destination:=Range("D45:E45"), Type:=xlFillDefault

Range("D45:E45").Select

Range("D34:D36").Select

Selection.AutoFill Destination:=Range("D34:E36"), Type:=xlFillDefault

Range("D34:E36").Select

ActiveWindow.SmallScroll Down:=-15

Range("D18").Select

Selection.AutoFill Destination:=Range("D18:E18"), Type:=xlFillDefault

Range("D18:E18").Select

ActiveWindow.SmallScroll Down:=-18

Range("D2").Select

Selection.AutoFill Destination:=Range("D2:E2"), Type:=xlFillDefault

Range("D2:E2").Select

ActiveWindow.SmallScroll Down:=60

Rows("74:74").Select

Selection.Copy

ActiveWindow.SmallScroll Down:=6

Application.CutCopyMode = False

Selection.Cut

ActiveWindow.SmallScroll Down:=-90

Rows("2:2").Select

Selection.Insert Shift:=xlDown

Columns("D:E").Select

Selection.Copy

Columns("H:H").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

Columns("L:L").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=4

Columns("P:P").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=7

Columns("T:T").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=4

Columns("X:X").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

Columns("AB:AB").Select

Selection.Insert Shift:=xlToRight

ActiveWindow.SmallScroll ToRight:=5

Application.CutCopyMode = False

Selection.Copy

Columns("AF:AF").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=4

Columns("AJ:AJ").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=5

Columns("AN:AN").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=3

Columns("AR:AR").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=5

Columns("AV:AV").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll ToRight:=-11

ActiveWindow.LargeScroll ToRight:=-1

ActiveWindow.SmallScroll ToRight:=-5

ActiveWindow.LargeScroll ToRight:=-1

Range("AV:AW,D:E,H:I,L:M").Select

Range("L1").Activate

ActiveWindow.SmallScroll ToRight:=8

Range("AV:AW,D:E,H:I,L:M,P:Q,T:U").Select

Range("T1").Activate

ActiveWindow.SmallScroll ToRight:=8

Range("AV:AW,D:E,H:I,L:M,P:Q,T:U,X:Y,AB:AC").Select

Range("AB1").Activate

ActiveWindow.SmallScroll ToRight:=11

Range("AV:AW,D:E,H:I,L:M,P:Q,T:U,X:Y,AB:AC,AF:AG,AJ:AK,AN:AO").Select

Range("AN1").Activate

ActiveWindow.SmallScroll ToRight:=10

Range("AV:AW,D:E,H:I,L:M,P:Q,T:U,X:Y,AB:AC,AF:AG,AJ:AK,AN:AO,AR:AS").Select

Range("AR1").Activate

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=8

Range("BC1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

ActiveWindow.SmallScroll ToRight:=-20

ActiveWindow.LargeScroll ToRight:=-1

ActiveWindow.SmallScroll ToRight:=-1

ActiveWindow.LargeScroll ToRight:=-1

Range("B1:C2").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=7

ActiveWindow.LargeScroll ToRight:=1

ActiveWindow.SmallScroll ToRight:=23

Range("BC1").Select

ActiveSheet.Paste

Range("BC1:BD1").Select

Application.CutCopyMode = False

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = True

End With

Selection.Copy

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("BC1:BZ1"), Type:=xlFillDefault

Range("BC1:BZ1").Select

ActiveWindow.SmallScroll ToRight:=-23

Range("BC2:BD2").Select

Selection.Copy

Range("BE2").Select

ActiveSheet.Paste

Range("BG2").Select

ActiveSheet.Paste

Range("BI2").Select

ActiveSheet.Paste

Range("BK2").Select

ActiveSheet.Paste

Range("BM2").Select

ActiveSheet.Paste

Range("BO2").Select

ActiveSheet.Paste

Range("BQ2").Select

ActiveSheet.Paste

Range("BR2").Select

Range("BS2").Select

ActiveSheet.Paste

Range("BU2").Select

ActiveSheet.Paste

Range("BW2").Select

ActiveSheet.Paste

Range("BY2").Select

ActiveSheet.Paste

Range("CA2").Select

ActiveWindow.SmallScroll ToRight:=4

ActiveSheet.Paste

Range("BY1:BZ1").Select

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("BY1:CB1"), Type:=xlFillDefault

Range("BY1:CB1").Select

ActiveWindow.SmallScroll ToRight:=-29

Range("AV3:AW74").Select

Selection.Copy

ActiveWindow.SmallScroll Down:=-63

ActiveWindow.SmallScroll ToRight:=26

Range("CA3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

ActiveWindow.SmallScroll ToRight:=-18

Range("BC3:CB74").Select

ActiveWindow.SmallScroll Down:=33

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll Down:=-18

Application.CutCopyMode = False

Selection.Cut

Application.CutCopyMode = False

Range("BC19:CX75").Select

Selection.Cut

ActiveWindow.SmallScroll Down:=-12

Range("BC4").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=12

Range("BC20:CC75").Select

Selection.Cut

ActiveWindow.SmallScroll Down:=-15

Range("BC5").Select

ActiveSheet.Paste

Range("BC16:CE74").Select

Selection.Cut

ActiveWindow.SmallScroll Down:=-15

Range("BC8").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=12

Range("BC16:CC71").Select

Selection.Cut

ActiveWindow.SmallScroll Down:=-12

Range("BC9").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=18

Range("BC29:CB67").Select

Selection.Cut

ActiveWindow.SmallScroll Down:=-12

Range("BC10").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-18

Range("BC13").Select

ActiveWindow.SmallScroll ToRight:=-3

ActiveWindow.LargeScroll ToRight:=-1

ActiveWindow.SmallScroll ToRight:=-3

ActiveWindow.LargeScroll ToRight:=-1

ActiveWindow.SmallScroll ToRight:=-13

Range("A3,A4").Select

Range("A4").Activate

ActiveWindow.SmallScroll Down:=15

Range("A3,A4,A35:A37").Select

Range("A35").Activate

ActiveWindow.SmallScroll Down:=18

Range("A3,A4,A35:A37,A46,A54").Select

Range("A54").Activate

ActiveWindow.SmallScroll Down:=18

Range("A3,A4,A35:A37,A46,A54,A74").Select

Range("A74").Activate

Selection.Copy

ActiveWindow.SmallScroll Down:=-60

ActiveWindow.SmallScroll ToRight:=48

Range("BB2").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Selection.Cut

Range("BB3").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll ToRight:=4

Range("BB11").Select

ActiveCell.FormulaR1C1 = "Somme"

Range("BC11").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-8]C:R[-1]C)"

Selection.AutoFill Destination:=Range("BC11:CB11"), Type:=xlFillDefault

Range("BC11:CB11").Select

ActiveWindow.SmallScroll Down:=-18

ActiveWindow.SmallScroll ToRight:=-20

Range("BB1:CB11").Select

Selection.Copy

Range("CE1").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll ToRight:=20

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=14

Range("DH1").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll ToRight:=-25

Range("CG:CG,CI:CI,CK:CK,CM:CM,CO:CO").Select

Range("CO2").Activate

ActiveWindow.SmallScroll ToRight:=11

Range("CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ,CS:CS,CU:CU,CW:CW,CY:CY").Select

Range("CY2").Activate

ActiveWindow.SmallScroll ToRight:=12

Range( _

"CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ,CS:CS,CU:CU,CW:CW,CY:CY,DA:DA,DC:DC,DE:DE,DJ:DJ" _

).Select

Range("DJ2").Activate

ActiveWindow.SmallScroll ToRight:=12

Range( _

"CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ,CS:CS,CU:CU,CW:CW,CY:CY,DA:DA,DC:DC,DE:DE,DJ:DJ,DL:DL,DN:DN,DP:DP,DR:DR,DT:DT,DV:DV" _

).Select

Range("DV2").Activate

ActiveWindow.SmallScroll ToRight:=11

Range( _

"CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ,CS:CS,CU:CU,CW:CW,CY:CY,DA:DA,DC:DC,DE:DE,DJ:DJ,DL:DL,DN:DN,DP:DP,DR:DR,DT:DT,DV:DV,DX:DX,DZ:DZ,EB:EB,ED:ED,EF:EF,EH:EH" _

).Select

Range("EH2").Activate

ActiveWindow.SmallScroll ToRight:=-43

Range("CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ").Select

Range("CQ2").Activate

ActiveWindow.SmallScroll ToRight:=7

Range("CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ,CS:CS,CU:CU,CW:CW").Select

Range("CW2").Activate

ActiveWindow.SmallScroll ToRight:=7

Range( _

"CG:CG,CI:CI,CK:CK,CM:CM,CO:CO,CQ:CQ,CS:CS,CU:CU,CW:CW,CY:CY,DA:DA,DC:DC,DE:DE" _

).Select

Range("DE2").Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlToLeft

ActiveWindow.SmallScroll ToRight:=-3

Range("CV:CV,CX:CX,CZ:CZ,DB:DB").Select

Range("DB2").Activate

ActiveWindow.SmallScroll ToRight:=8

Range("CV:CV,CX:CX,CZ:CZ,DB:DB,DD:DD,DF:DF,DH:DH,DJ:DJ").Select

Range("DJ2").Activate

ActiveWindow.SmallScroll ToRight:=10

Range( _

"CV:CV,CX:CX,CZ:CZ,DB:DB,DD:DD,DF:DF,DH:DH,DJ:DJ,DL:DL,DN:DN,DP:DP,DR:DR,DT:DT" _

).Select

Range("DT2").Activate

Selection.Delete Shift:=xlToLeft

ActiveWindow.SmallScroll ToRight:=-24

End Sub

En espérant que vous pouvais m'aider.

Merci par avance

11tt18h.xlsx (23.30 Ko)
10tt19hpb.xlsx (24.10 Ko)
Le 22/05/2010 à 13:40

Bonjour,

Plutôt que ce code indigeste, dis-nous ce qu'est censée faire cette macro

Amicalement

Claude

Le 22/05/2010 à 14:18

Il s'agit en faite d'une série de manipulation visant à obtenir un tableau de synthèse de cesdonnées brutes, l'ensemble des étapes sont décrites sur les document excel ci joint, en espérant que se soit assez claire.

Merci

PS: c'est l'étape 7 qui déconne

14tt20h.xlsx (28.31 Ko)
Le 22/05/2010 à 14:51

Bonjour,

Le tri est censé faire quoi au début du code.

As-tu toujours 74 lignes ou plus ?

Plus bas tu mets des formules toutes les 16 lignes; tu peux expliquer

Je n'ai pas l'impression que te rendes compte de l'analyse à faire pour comprendre et te faire un code qui fonctionne selon tes besoins.

Amicalement

Le 22/05/2010 à 15:17

Alors en fait la première colonne représente de codes de cases (B1 BP BS C C1 CP CS RB) que j'ai réunis elles ne sont pas trier à la base c'est pour sa qu'il y a un trie au début.

Tout mes tableaux sont identiques.

Les formules toutes les 16 lignes je vois pas trop où mais si c'est les deux colonnes vides il s'agit juste des sommes pour chaque CODE et ainsi obtenir le tableau de synthèse de chacun d'entre eux.

Je suis conscient de la complexité de la chose,mais c'était juste histoire de voir s'il y avais une solution simlpe, si non c pas grave pas de souci je vais faire sa à la main, c pas comme si j'avais 100 tableaux a traiter.

Par contre juste pour petit rappelle, la macro fonctionne bien, jusqu'au passage 3 (colonne F a peut près) où tout se décale il me semble que c juste sa qui déconne mais j'arrive pas sa voir où se passage s'opère dans le code.

Mais sincèrement galéré pas c'était justehistoire de gagner un peut de temps mais sans pour autant vous en faire perdre, en tout cas merci.

Le 22/05/2010 à 15:25

re, salut Dan,

Ce que j'ai cru comprendre, à voir !

Sub essai()
    Columns("B:E").Copy
    Columns("B:B").Insert Shift:=xlToRight
    Columns("B:C").ClearContents
    Application.CutCopyMode = False
    MsgBox ("Prêt à recevoir les données en colonnes B:C")
End Sub

Amicalement

Claude

Le 22/05/2010 à 15:34

Au cas où j'ai fait réaliser une macro unique pour la partie qui pose problème le problème sera peut être plus simple du cout, voici le code pour copier coller avec les formules la colonne D & E toutes les deux colonnes suivante, là encore au passage 3 (colonne LL)il y à un décalage qui s'opère:

Sub Macro3()

'

' Macro3 Macro

'

'

Columns("D:E").Select

Selection.Copy

Columns("H:H").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

Columns("L:L").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=6

Columns("P:P").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=4

Columns("T:T").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=4

Columns("X:X").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=4

Columns("AB:AB").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=8

Columns("AF:AF").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

Columns("AJ:AJ").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=3

Columns("AN:AN").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=5

Columns("AR:AR").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

Columns("AV:AV").Select

Selection.Insert Shift:=xlToRight

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll ToRight:=8

Columns("AZ:AZ").Select

Selection.Insert Shift:=xlToRight

ActiveWindow.SmallScroll ToRight:=-13

End Sub

-- 22 Mai 2010, 15:35 --

Re désolé dubois mais je vois pas trop se que réalise al macro

-- 22 Mai 2010, 15:46 --

Ok c'estbon 'ai triché un peut j'ai fait deux macros qui décomposent mes manipulations de donnée et je saute la partie qui pose problème, elle ne représente que 13 copier coller par classeurs, et le reste est otomatiser.

en tout cas merci a vous deux d'avoir tenter de résoudre mon problème.

Merci merci

12tt22h.xlsx (19.84 Ko)
8tt19h.xlsx (18.47 Ko)
Le 22/05/2010 à 16:38

re,

Bon tu copies les colonnes D:E vers H

Puis la colonne H vers L

puis L vers P

En gros cela revient à copie

D:E vers H puis D vers L, D vers P, etc...

En ligne 2, tu as des infos FR et TC, est-ce que la copie doit se faire dans la colonne juste après la colonne comportant le TC ou non

Le 22/05/2010 à 17:09

oui voilà c'est sa

Le 22/05/2010 à 17:59

Re,

Sur base du fichier THT19, essaie ceci :

Sub Macro3()
' Macro Dan pour Basosa le 22/05/2010
'http://forum.excel-pratique.com/excel/probleme-avec-une-macro-enregistre-t17358.html
Application.ScreenUpdating = False
For i = 30 To 8 Step -2
Columns("D:E").Copy
Columns(i).Insert Shift:=xlToRight
Next
Application.CutCopyMode = False
End Sub

Evite de mettre à chaque reprise un fichier si ce n'est pas nécessaire, cela alourdit le forum et il vaut mieux travailler sur un seul fichier, c'est moins compliqué.

Le 22/05/2010 à 18:10

ok C BON!!!! c'est nikel je vais finir avec sa. Merci a toi.désolé pour les n fichiers envoyés

Rechercher des sujets similaires à "probleme macro enregistre"