Makro do kopiowania hiperłącza z innego arkusza [zamknięte]

Mam makro, które znalazłem na tej stronie, aby skopiować hiperłącza wstawione przez wstążkę do innej kolumny w innym arkuszu. Jednak makro działa tylko w pierwszym wierszu.

Dodałem, Dodopóki i = 7 to 1007nie zmusiłem go do przejścia na next. Teraz upłynął limit czasu i nadal nie działa. Chciałbym po prostu użyć do tego funkcji, ale stwarza to problemy innym użytkownikom na Macu, więc staram się omijać Maca, ponieważ jest to trudne.

Powinienem stwierdzić, że niektóre wiersze na pierwszym arkuszu są puste.

Sub SwapIt()
    Dim i As Integer
    i = 7
    Do Until i > 1007
        Dim newLink As String
        If Worksheets("Directory").Active = True Then
        newLink = Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks(1).Address ' Get the old horrible link :)
        Worksheets("Directory").Range("B" & i).Hyperlinks.Add anchor:=Worksheets("Directory").Range("B" & i), Address:=Worksheets("Directory").Range("B" & i) 'turns it to a link
        Worksheets("Directory").Range("B" & i).Hyperlinks(1).Address = newLink 'replace with the new link.
        i = i + 1
        End If
    Loop

End Sub

Każda pomoc będzie mile widziana. Doprowadza mnie to do szału.

Tak! Rozgryzłem to. Tylko brakujący zakres.

Sub SwapIt()
Dim i As Integer
For i = 7 To 1007
If Worksheets("Modeling Tracker").Range("S" & i).Value > "" Then
    Dim newLink As String
    If Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks.Count = 1 Then
    newLink = Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks(1).Address 
    Worksheets("Directory").Range("B" & i).Hyperlinks.Add Anchor:=Worksheets("Directory").Range("B" & i), Address:=Worksheets("Directory").Range("B" & i) 'turns it to a link
    Worksheets("Directory").Range("B" & i).Hyperlinks(1).Address = newLink '' replace with the new link.
    End If
End If
Next i
End Sub

Oto poprawiony kod. Dodałem również, jeśli tak, jeśli oryginalna komórka łącza była pusta, usunąłby hiperłącze w nowym arkuszu, ponieważ po zastosowaniu informacji komórki odpowiadające pustym polom na drugim arkuszu nadal miały stare hiperłącze od ostatniego zastosowania makra .

Sub UpdateLinks_Click()
' Copy the hyperlink from Modeling Tracker Sheet and apply it to the Directory

Dim i As Integer

For i = 7 To 1007

If Worksheets("Modeling Tracker").Range("S" & i).Value > "" Then
Dim newLink As String
    If Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks.Count = 1 Then
    newLink = Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks(1).Address ' Get the link from the Modeling Tracker
    Worksheets("Directory").Range("B" & i).Hyperlinks.Add Anchor:=Worksheets("Directory").Range("B" & i), Address:=Worksheets("Directory").Range("B" & i) 'turns it to a link
    Worksheets("Directory").Range("B" & i).Hyperlinks(1).Address = newLink 'replace it with newLink
    End If
End If
If Worksheets("Modeling Tracker").Range("S" & i).Value = "" Then
Worksheets("Directory").Range("B" & i).Hyperlinks.Delete
End If
Next i
Worksheets("Directory").Range("B7:B1007").Font.Color = vbBlack ' this to is avoid the auto hyperlink format
Worksheets("Directory").Range("B7:B1007").Font.Underline = False ' this is to avoid the auto-hyperlink format
End Sub