Macro

Résolu
Gwen59000 -  
Bonjour,

J'ai créé une macro que je dois appliquer à chaque cellule de la même colonne, k776 à k1006.
Je fais actuellement la manip à la main cellule par cellule. Pourriez vous m'expliquer ce que je dois ajouter dans cette macro pour qu'elle s'execute d'elle même à la cellule suivante et ce de k776 à k1006.

Merci d'avance,
Configuration: Windows XP Internet Explorer 7.0

9 réponses

  1. Pimp92a
    Bonjour,

    Peux-tu envoyer le code de ta macro
    1
    1. Gwen59000 Auteur
      La voici,
      Les cellules de la colonne k dans mon classeur principal contiennent un lien hypertexte qui me conduit directement à un autre classeur excel plus détaillé. Chaque cellule correspond à un fichier excel. C'est une fois avoir cliqué sur ce lien et donc ouvert le classeur excel correspondant que j'éxécute la macro suivante puis je fais de même pour la cellule suivante et la suivante...

      Sub MODIFEXP()
      '
      ' MODIFEXP Macro
      ' Macro enregistrée le 28/12/2009 par
      '
      ' Touche de raccourci du clavier: Ctrl+Maj+M
      '
      Range("C27:D38").Select
      Selection.Copy
      Range("C6:D17").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False
      Range("H27:I38").Select
      Selection.Copy
      Range("H6:I17").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False
      Range("G22:U23").Select
      Selection.Copy
      Range("J1:U2").Select
      ActiveSheet.Paste
      Application.CutCopyMode = False
      Range("G22:U23").Select
      Windows("201.xls").Activate
      Range("B4:U5").Select
      Selection.Copy
      Windows(2).Activate
      Range("B4:U5").Select
      ActiveSheet.Paste
      Windows("201.xls").Activate
      Application.CutCopyMode = False
      Range("E6").Select
      Selection.Copy
      Windows(2).Activate
      Range("E6").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("J6").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("O6").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("T6").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("E6").Select
      Application.CutCopyMode = False
      Selection.AutoFill Destination:=Range("E6:F6"), Type:=xlFillDefault
      Range("E6:F6").Select
      Selection.AutoFill Destination:=Range("E6:F17"), Type:=xlFillDefault
      Range("E6:F17").Select
      Range("J6").Select
      Selection.AutoFill Destination:=Range("J6:K6"), Type:=xlFillDefault
      Range("J6:K6").Select
      Selection.AutoFill Destination:=Range("J6:K17"), Type:=xlFillDefault
      Range("J6:K17").Select
      Range("O6").Select
      Selection.AutoFill Destination:=Range("O6:P6"), Type:=xlFillDefault
      Range("O6:P6").Select
      Selection.AutoFill Destination:=Range("O6:P17"), Type:=xlFillDefault
      Range("O6:P17").Select
      Range("T6").Select
      Selection.AutoFill Destination:=Range("T6:U6"), Type:=xlFillDefault
      Range("T6:U6").Select
      Selection.AutoFill Destination:=Range("T6:U17"), Type:=xlFillDefault
      Range("T6:U17").Select
      Windows("201.xls").Activate
      Range("E18").Select
      Selection.Copy
      Windows(2).Activate
      Range("E18").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("J18").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("O18").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("T18").Select
      Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Range("E18").Select
      Application.CutCopyMode = False
      Selection.AutoFill Destination:=Range("E18:F18"), Type:=xlFillDefault
      Range("E18:F18").Select
      Range("J18").Select
      Selection.AutoFill Destination:=Range("J18:K18"), Type:=xlFillDefault
      Range("J18:K18").Select
      Range("O18").Select
      Selection.AutoFill Destination:=Range("O18:P18"), Type:=xlFillDefault
      Range("O18:P18").Select
      Range("T18").Select
      Selection.AutoFill Destination:=Range("T18:U18"), Type:=xlFillDefault
      Range("T18:U18").Select
      Range("A22:U39").Select
      Selection.ClearContents
      With Selection
      .Orientation = 0
      .AddIndent = False
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      End With
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      Selection.Borders(xlEdgeLeft).LineStyle = xlNone
      Selection.Borders(xlEdgeTop).LineStyle = xlNone
      Selection.Borders(xlEdgeBottom).LineStyle = xlNone
      Selection.Borders(xlEdgeRight).LineStyle = xlNone
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
      Selection.Interior.ColorIndex = 15
      Rows("3:3").Select
      Selection.RowHeight = 100
      Range("A3").Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      Selection.Borders(xlEdgeRight).LineStyle = xlNone
      Range("A1:A2").Select
      With ActiveSheet.PageSetup
      .PrintTitleRows = ""
      .PrintTitleColumns = ""
      End With
      ActiveSheet.PageSetup.PrintArea = ""
      With ActiveSheet.PageSetup
      .LeftHeader = ""
      .CenterHeader = ""
      .RightHeader = ""
      .LeftFooter = ""
      .CenterFooter = ""
      .RightFooter = ""
      .LeftMargin = Application.InchesToPoints(0.787401575)
      .RightMargin = Application.InchesToPoints(0.787401575)
      .TopMargin = Application.InchesToPoints(0.984251969)
      .BottomMargin = Application.InchesToPoints(0.984251969)
      .HeaderMargin = Application.InchesToPoints(0.4921259845)
      .FooterMargin = Application.InchesToPoints(0.4921259845)
      .PrintHeadings = False
      .PrintGridlines = False
      .PrintComments = xlPrintNoComments
      .PrintQuality = 600
      .CenterHorizontally = False
      .CenterVertically = False
      .Orientation = xlLandscape
      .Draft = False
      .PaperSize = xlPaperA4
      .FirstPageNumber = xlAutomatic
      .Order = xlDownThenOver
      .BlackAndWhite = False
      .Zoom = 100
      .PrintErrors = xlPrintErrorsDisplayed
      End With
      ActiveWindow.ScrollRow = 2
      ActiveWindow.ScrollRow = 3
      ActiveWindow.ScrollRow = 4
      Range("A41:U41").Select
      Selection.AutoFill Destination:=Range("A32:U41"), Type:=xlFillDefault
      Range("A32:U41").Select
      ActiveWindow.ScrollRow = 3
      ActiveWindow.ScrollRow = 2
      ActiveWindow.ScrollRow = 1
      Range("F18").Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      Range("K18,P6:P18").Select
      Range("P6").Activate
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      Range("T6:T18").Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      With Selection.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
      End With
      Range("A1:A2").Select

      ActiveWorkbook.Save
      ActiveWorkbook.Close
      End Sub
      0
      1. Pimp92a
        Ok jtu dois pouvoir faire une boucle sur les cellules en fonction d'un critère
        0
        1. TiboleParano
          tu rajoutes ceci je crois: 
          x = 776
Do While x<=1006

GrandX_mystère_1

[ton code maccro]

GrandX_mystère_2

x = x + 1
Loop


          Voilaà, le code fera une bouclera entre Do while ... et Loop, il repetera ton code (1006-776)fois
          Le problème c'est que dans tes cellules tu dois ouvrir le lien du nouveau classeur, et appliquer la maccro sur ce classeur, et revenir en reprenant le focus sur le classeur principal, il va falloir chercher encor un peu
          Voici les GrandXs:
          GrandX_mystère_1: doit selectionner la cellule (x,11) (11 correspond à k); ouvrir le lien qu'il contient; définir le focus sur la nouvelle fenêtre
          GrandX_mystère_2: ta maccro quitte le sous-classeur toute seule si je me trompe pas. Reprise du focus sur le classeur principal pour recomencer la prochaine boucle ..
          0
          2. TiboleParano
            Sinon jvoudrai que tu test quelque chose: tu enregistre une maccro ou tu ne fais que cliquer sur un lien, puis tu arretes l'enregistrement, et tu copie le code qu'il te met
            Sinon j'ai trouvé la fonction FollowHyperLink
            de la forme: 
            [application.]FollowHyperlink address, [subaddress], [newwindow], [addhistory], [extrainfo], [method], [headerinfo]

            qui se taperait donc dans ton cas:
            application.FollowHyperlink Cells(x,11)
            (je pense que le "application." est facultatif)
            Cells(x,11) sélectionne la case k776~1006
            fais un test pour voir si sa tlance kkchose ...
            0
            1. Gwen59000 Auteur
              J'ai essayé ceci mais message d'erreur pour la ligne "Range..." Je fais mes débuts en macro, ne pas se moquer !
              Une explication ?

              Sub essai()
              '
              ' essai Macro
              ' Macro enregistrée le 29/12/2009 par
              '

              '
              For i = 776 To 1006

              Range("Ki+1").Select
              Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
              Application.Run "'202.xls'!MODIFEXP"(ma macro)
              Windows("RECAPITULATIF CLIENTS.xls").Activate

              Next i
              End Sub
              0
              1. TiboleParano
                alors pour la ligne range l'erreur est "Ki+1", c'est évident qu'il ne le reconnait pas, il ne remplace pas i par sa valeur et l'incremente encore moins =/
                d'ailleurs pourquoi incrementes-tu ?
                Sinon je vois 2solutions pour remplacer ton range:
                la solution que je t'avais proposé: 
                range(i,11)

                avec i en numéro de ligné
                et 11 en numéro de colonne (11=K)
                ou, avec ta méthode: 
                range("K" & i)
ou
range("K" & (i+1) )

                NB: le & sert à concatener: en gros il colle la valeur de i après K, genre i=805: "K" & i => "K805"
                et j'ai mis 2codes à savoir sans et avec incrémentation, choisis celui que tu veux
                PS: moi aussi je suis nouveau en macro, sa fait 4jours que jm'y coltine pour ltaff ^^ et bien joué, jvois que t'as trouvé les morceaux de code qui manque, tu m'impressiones :)
                0
                1. Gwen59000 Auteur
                  Merci ça fonctionne. Comment en sais tu autant en 4 jours sur la macro ?????
                  0
                  1. TiboleParano
                    J'avoue avoir en partie menti, sa fait des années que j'aprends différents languages C,html,php ... donc même avec seulement 4jours d'access, jretiens facilement, surtout les trucs basiques svt nécessaires: range pour selectionner une cellule, do while pour une boucle, & pour concatener
                    après jsuis paumé sur les plus grosses fonctions, c'est pour sa que tu m'as épaté quand jt'ai expliqué ce qu'il fallait (GrandX_mystère :P) et que t'as trouvé de suite les fonctions, et adaptée
                    et franchement si ta fonction marche déjà impec, je tire mon chapeau, je suis habitué aux problèmes en cascade en prog, jcafouille un peu trop parfois ^^
                    sur ce jpense que jraconte ma vie, donc j'arrete de m'afficher sur ce mot: Topinambour
                    ;) Have fun
                    0

                    Discussions similaires

                    Transformer un chiffre en lettres dans excel sans macro
                    vincentphilippos

                    6 réponses
                    recup couleur de cellule sans macro
                    magouero

                    7 réponses