Boucle sur deux colonnes

Bonjour

Je recherche à créer une boucle sur deux colonnes.

Colonne B une série de chiffres liés à un document sur internet sur un site (ex. google)

Colonne C une autre série de chiffres pour un autre site (ex. Ask).

Normalement les boucles fonctionnent ligne par ligne.

J’ai créé deux boucles pour me faire ce traitement, mais j’avoue que ne trouve pas cela très jolie.

Y aurais t’il aune méthode plus simple pour ce traitement ?

Voici ma boucle actuelle.

Sub Boucle()
 Derligne_cible = Range("B2000").End(xlUp).Row 'trouve la dernière ligne de la colonne B
 Range("B2").Select 'cellule de démarrage
 'Traitement des N° et des liens (colonne B)
     For l = 1 To Derligne_cible 'l => n° ligne ver la fin
     If ActiveCell <> "" Then
         Destination = ActiveCell.Address(0, 0) ' cellule de destination
     Valeur = ActiveCell
 '    ActiveCell.ClearContents
         With ActiveSheet 'sur cette feuille
             .Range(Destination) = Valeur
             .Hyperlinks.Add .Range(Destination), "http://www.google=" & Valeur 'ajoute le lien + la valeur de la cellule
         End With
     ActiveCell.Offset(1, 0).Activate 'ligne suivante
     Else
     ActiveCell.Offset(1, 0).Activate 'ligne suivante
     End If
     Next 'Boucle suivante
 Range("C2").Select 'cellule de démarrage
 'Traitement des N° et des liens (colonne C)
     For l = 1 To Derligne_cible 'l => n° ligne ver la fin
     If ActiveCell <> "" Then
         Destination = ActiveCell.Address(0, 0) ' cellule de destination
     Valeur = ActiveCell
         With ActiveSheet 'sur cette feuille
             .Range(Destination) = Valeur
             .Hyperlinks.Add .Range(Destination), "http://www.ask=" & Valeur 'ajoute le lien + la valeur de la cellule
         End With
     ActiveCell.Offset(1, 0).Activate 'ligne suivante
     Else
     ActiveCell.Offset(1, 0).Activate 'ligne suivante
     End If
     Next 'Boucle suivante
     Range("B21").Select 'retour a la cellule de démarrage
 End Sub

Merci d'avance pour votre aide.

Bonjour,

Une proposition.

Cdlt.

Public Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long
Dim rngData As Range, Cell As Range

    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    With ws
        lastRow = .Cells(1).CurrentRegion.Rows.Count
        Set rngData = .Range("B2:C" & lastRow)
        For Each Cell In rngData
            If Not IsEmpty(Cell) Then
                Select Case Cell.Column
                    Case 2
                        .Hyperlinks.Add Cell, "http://www.google=" & Cell.Value
                    Case 3
                        .Hyperlinks.Add Cell, "http://www.ask=" & Cell.Value
                End Select
            End If
        Next Cell
    End With

    Set rngData = Nothing: Set ws = Nothing

End Sub

Phénoménale, et une rapidité d’exécution déconcertante.

Mes respects.

Merci beaucoup.

Puis-je te demander de me la documenter pour que je la comprenne.

Cela me permettrait de la comprendre, d’apprendre et si besoin de la reproduire.

Merci d’avance.