Boucle

bonjour ,

afin d'optimiser mon code et d'éviter de créer une macro pour chaque colonne

ce que que je souhaiterai c'est créer une macro qui va agir sur la colonne 1 de A1 à A8 qui va récupérer les données avec activecell

ensuite basculer sur la colonne 2 de B1 à B8 et ainsi de suite jusqu'a la dernière colonne Pleine puis fin de la macro

voir le fichier pour avoir une idée

exemple de code:

[code]sub test()

While ActiveCell.value <> ""

'mes instructions

'

wend

End Sub/code]

Merci pour votre aide

Oups 'j ai oublier de joindre le fichier

8classeur3.xlsx (30.28 Ko)

Bonjour,

On n'utilise ActiveCell que si on écrit une macro qui devra s'appliquer sur la cellule qu'on lui indiquera par ce moyen.

Si on sait sur quelles cellules on opére ou si on peut le déterminer autrement, ActiveCell est à proscrire !

Si tu disais ce qui doit être fait : récupérer des données ? Pour en faire quoi ?

Je peux récupérer A1:E8 en une fois, je peux récupérer A1:A8 en un fois, etc. Tout dépend de ce que je vais en faire ensuite...

Ces données récupérer seront copier vers un logiciel d’émulation « Bluezone » dans très champs précis.

Connais pas !

Tu fournis tout à la fois ? Par morceaux ? Sous quelle forme ?

effectivement avec une code c'est mieux

voila ce code me permet actuellement d'agir que sur la colonne A et mon objectif est que lorsque la boucle est fini en passe a la suivante jusqu'a la derniere colonne pleine

j'espere m'etre bien explique

Merci

Sub UpdateOSPR()

    Dim theRoute, theRow, theMessage, theExistingRoute
    Dim theDate, theOrigin, theDestin
    Dim updateCIABR, lastUpdate
    Dim readValue
    Dim routeFOUND As Boolean
    Dim rowLOCATION

    Dim default, Title, message, pcs As Integer

    message = "Entrer la Date  ? DDMMMYY format:"   ' Set prompt.
    Title = "Route Date" ' Set title.
    sDate = format(Date, "ddmmmyy")
    default = sDate   ' Set default.
    theDate = Range("K1").Value

    '
            Set bz = CreateObject("BZWhll.WhllObj")
             bz.Connect ""

            With bz

'*****************************

 Do While Feuil2.Cells(theRow, 1) <> ""

                 updateCIABR = formOSPR.includeCRN
                theRoute = Range("A2").Value
                'theDate = formOSPR.input_date
                theOrigin = "cdg"
                theDestin = Range("A1").Value

                theRow = 3

                Do While Feuil2.Cells(theRow, 1) <> ""

                    If lastUpdate <> "IABR" Then
                    'reset value
                        .setcursor 1, 14
                        .SendKey "IABR"
                        .SendKey "<ENTER>"
                            .WaitReady 10, 1
                    End If

                    lastUpdate = "IABR"

                    'enter AWB
                        .setcursor 2, 14
                        .SendKey Feuil2.Cells(theRow, 1)
                        .SendKey "<ENTER>"
                        .WaitReady 10, 1

                    'verify the result
                        .readScreen theMessage, 40, 23, 1
                            theMessage = Trim(theMessage)

                        If theMessage = "AIRBILL NOT FOUND." Then ' "AWB NUMBER NOT FOUND." Then
                            'handling NOT FOUND ==> CRNs
                            If updateCIABR = False Then
                                Feuil2.Cells(theRow, 6) = "NOT FOUND"

                            Else
                                'reset value
                                    .setcursor 1, 14
                                    .SendKey "CIABR"
                                    .SendKey "<ENTER>"
                                    .WaitReady 10, 1

                                lastUpdate = "CIABR"

                                'enter AWB
                                    .setcursor 2, 9
                                    .SendKey Feuil2.Cells(theRow, 1)
                                    .SendKey "<ENTER>"
                                    .WaitReady 10, 1

                                'verify the result
                                    .readScreen theMessage, 40, 23, 1
                                        theMessage = Trim(theMessage)

                                    If theMessage = "CRN NUMBER NOT FOUND." Then
                                        Feuil2.Cells(theRow, 5) = ""

                                    Else

                                        'search for route in existing routing
                                        'search for locaton in routing
                                        routeFOUND = False
                                        rowLOCATION = 6
                                        For i = 6 To 20
                                            .readScreen theExistingRoute, 7, i, 4
                                            .readScreen readValue, 5, i, 26
                                            If UCase(Trim(theRoute)) = UCase(Trim(theExistingRoute)) Then
                                                routeFOUND = True
                                                Exit For
                                            ElseIf UCase(Trim(readValue)) = UCase(Trim(theOrigin)) Then
                                                rowLOCATION = i + 1
                                            End If
                                        Next i

                                        If routeFOUND Then
                                            Feuil2.Cells(theRow, 6) = ""

                                        Else

                                            .setcursor 1, 79
                                            .SendKey "U"

                                                i = rowLOCATION

                                                Do
                                                    'select row for deletion
                                                    .setcursor i, 2
                                                    .SendKey "D"

                                                    'check next row
                                                    i = i + 1
                                                    .readScreen readValue, 7, i, 12
                                                Loop While Trim(readValue) <> ""

                                            'add new row with route
                                            .setcursor i, 2
                                            .SendKey "A"
                                            .setcursor i, 4
                                            .SendKey theRoute
                                            .setcursor i, 12
                                            .SendKey theDate
                                            .setcursor i, 20
                                            .SendKey theOrigin
                                            .setcursor i, 26
                                            .SendKey theDestin

                                            .SendKey "<ENTER>"
                                            .WaitReady 10, 1

                                            .SendKey "<ENTER>"
                                            .WaitReady 10, 1

                                                    End If

                                            End If

                                        End If

                                    End If

                theRow = theRow + 1
                Loop

            End With

End Sub
Rechercher des sujets similaires à "boucle"