Макрос для копирования гиперссылки с другого листа

Question

У меня есть макрос, который я нашел на этом сайте, чтобы скопировать гиперссылки, вставленные через ленту, в другой столбец на другом листе. Тем не менее, макрос работает только в первом ряду.

Я добавил Do потому что i = 7 to 1007 не заставлял его переходить к next . Сейчас время истекло, и оно все еще не работает. Я бы просто использовал для этого функцию, но она создает проблемы для другого пользователя в Mac, поэтому я пытаюсь обойти Mac очень сложно.

Я должен заявить, что некоторые строки на первом листе не заполнены.

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

Любая помощь будет оценена. Это сводит меня с ума.

Ура! Я понял. Просто недостающий диапазон.

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

Answer 1

Вот фиксированный код. Я также добавил «Если так», если исходная ячейка ссылки была пустой, гиперссылка на новом листе была бы удалена, потому что при восстановлении информации ячейки, которые соответствовали пробелам на другом листе, все еще имели старую гиперссылку от последнего применения макроса ,

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