none
Question VBA RRS feed

  • Question

  • Bonjour,

    Je suis novice en VBA et je suis en train de faire une macro. J'ai plusieurs lignes de code de ce type:

    Set R = Sheets("PTP").Range("A2")
    Sheets("Copie_TCD").Activate
    Mot = "PTPP1"
        For Each Cel In ActiveSheet.UsedRange
            If UCase(Cel) = UCase(Mot) Then
              Cel.Columns("A:H").Copy R
              Set R = R.Offset(1)
            End If
        Next Cel
    Set R = Sheets("PTP").Range("A30")
    Sheets("Copie_TCD").Activate
    Mot = "PTPP2"
        For Each Cel In ActiveSheet.UsedRange
            If UCase(Cel) = UCase(Mot) Then
              Cel.Columns("A:H").Copy R
              Set R = R.Offset(1)
            End If
        Next Cel

    Ces lignes de code fonctionnent, mais dès que j'essaie de faire une double boucle celà ne marche plus. Je souhaite à chaque boucle incrémenter i, pour que le Mot change, et dans le même temps copier ma sélection à une ligne spécifique d'une autre feuille (le numéro de ligne est incrémenté de 27 à chaque fois).

    J'ai essayé le code suivant, mais ça ne fonctionne pas:

    Dim Cel As Range
    Dim Mot As String
    Dim R As Range
    Dim i, j As Integer

    j = 3

    For i = 1 To i = 12
        Set R = Sheets("FDF").Range("A" & j)
        Sheets("Copie_TCD").Activate
        Mot = "FDFP" & i
            For Each Cel In ActiveSheet.UsedRange
                If UCase(Cel) = UCase(Mot) Then
                  Cel.Columns("A:H").Copy R
                  Set R = R.Offset(1)
                End If
            Next Cel
        j = j + 27
    Next i

    End Sub

    MERCI d'avance pour votre aide!

    mercredi 5 février 2014 10:59

Réponses

  • Bonjour,

    Au delà d'une erreur de calcul de ma part (que ce soit la ligne 246 ou 248 m'importe peu en fait), mon problème était un peu plus profond que ça car la macro ne marchait pas. 

    J'ai cependant réussi à résoudre mon problème avec le code suivant: For i=1 to 12 (au lieu de for i=1 to i=12).

    Bonne journée

    • Marqué comme réponse Aurel Bera mardi 11 février 2014 14:50
    jeudi 6 février 2014 09:05

Toutes les réponses

  • Bonjour,

    Est-ce que ceci fonctionne mieux ?

    Dim Cel As Range
    Dim Mot As String
    Dim R As Range
    Dim i, j As Integer
    j = 2
    
    For i = 1 To i = 12
        Set R = Sheets("FDF").Range("A" & j)
        Sheets("Copie_TCD").Activate
        Mot = "FDFP" & i
            For Each Cel In ActiveSheet.UsedRange
                If UCase(Cel) = UCase(Mot) Then
                  Cel.Columns("A:H").Copy R
                  Set R = R.Offset(1)
                End If
            Next Cel
        j = j + 28
    Next i
    

    Au lieu de tester chaque cellule de la plage utilisée, utilise plutôt la méthode Find :

    Dim Cel As Range
    Dim Mot As String
    Dim R As Range
    Dim i, j As Integer
    Dim ResAdr As String
    j = 2
    
    For i = 1 To i = 12
        Set R = Sheets("FDF").Range("A" & j)
        Sheets("Copie_TCD").Activate
        Mot = "FDFP" & i
        Set Cel = ActiveSheet.UsedRange(Mot, , , xlWhole)
        If Not Cel Is Nothing Then
            ResAdr = Cel.Address
            Do
                Cel.Columns("A:H").Copy R
                Set R = R.Offset(1)
                Set Cel = ActiveSheet.UsedRange.FindNext(Cel)
            Loop While Cel.Address <> ResAdr
        End If
        j = j + 28
    Next i
    

    (non testé).

    Daniel

    mercredi 5 février 2014 14:03
  • Merci pour votre suggestion, je viens de la tester, mais malheureusement, comme avec mon premier code, pas d'erreur, mais juste aucun effet.
    mercredi 5 février 2014 14:08
  • Bonjour

    Vous avez "On error resume next" ?
    Ça peut cacher des erreurs.

    Cordialement,


    Aurel BERA, MSFT
    MSDN Community Support. LE CONTENU EST FOURNI "TEL QUEL" SANS GARANTIE D'AUCUNE SORTE, EXPLICITE OU IMPLICITE.
    S'il vous plaît n'oubliez pas de "Marquer comme réponse" les réponses qui ont résolu votre problème. C'est une voie commune pour reconnaître ceux qui vous ont aidé, et rend plus facile pour les autres visiteurs de trouver plus tard la résolution.

    mercredi 5 février 2014 14:37
  • Je viens de l'activer, mais pas d'erreur détectée...
    mercredi 5 février 2014 14:44
  • En effet il doit être désactivé pour afficher l’erreur. 

    Aurel BERA, MSFT
    MSDN Community Support. LE CONTENU EST FOURNI "TEL QUEL" SANS GARANTIE D'AUCUNE SORTE, EXPLICITE OU IMPLICITE.
    S'il vous plaît n'oubliez pas de "Marquer comme réponse" les réponses qui ont résolu votre problème. C'est une voie commune pour reconnaître ceux qui vous ont aidé, et rend plus facile pour les autres visiteurs de trouver plus tard la résolution.

    mercredi 5 février 2014 14:55
  • Dans un cas comme dans l'autre, aucune erreur n'apparaît ...
    mercredi 5 février 2014 16:24
  • Publie l'intégralité de ta macro et précise dans quel module elle se trouve.

    Daniel

    mercredi 5 février 2014 20:25
  • Bonjour, ma macro se trouve dans le module général. Voici le code complet. Merci d'avance

    Option Explicit
    Sub copiedesti()

    Dim Cel As Range
    Dim Mot As String
    Dim R As Range

    Set R = Sheets("PTP").Range("A3")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP1"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A30")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP2"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A57")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP3"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A84")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP4"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A111")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP5"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A138")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP6"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A165")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP7"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A192")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP8"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A219")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP9"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A248")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP10"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A275")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP11"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    Set R = Sheets("PTP").Range("A302")

    Sheets("Copie_TCD").Activate

    Mot = "PTPP12"

        For Each Cel In ActiveSheet.UsedRange

            If UCase(Cel) = UCase(Mot) Then

              Cel.Columns("A:H").Copy R

              Set R = R.Offset(1)

            End If

        Next Cel

    End Sub

    jeudi 6 février 2014 08:16
  • Bonjour,

    en ce qui concerne la ligne :

    Set R = Sheets("PTP").Range("A3")

    A3, évolue avec une progression de 27; alors pourquoi passe-t-on de :

    Set R = Sheets("PTP").Range("A219")

    à :

    Set R = Sheets("PTP").Range("A248")

    au lieu de A246 ?

    Daniel

    jeudi 6 février 2014 09:01
  • Bonjour,

    Au delà d'une erreur de calcul de ma part (que ce soit la ligne 246 ou 248 m'importe peu en fait), mon problème était un peu plus profond que ça car la macro ne marchait pas. 

    J'ai cependant réussi à résoudre mon problème avec le code suivant: For i=1 to 12 (au lieu de for i=1 to i=12).

    Bonne journée

    • Marqué comme réponse Aurel Bera mardi 11 février 2014 14:50
    jeudi 6 février 2014 09:05