Macro para copiar o hiperlink de outra planilha [closed]

Question

Eu tenho uma macro que encontrei neste site para copiar hiperlinks inseridos pela faixa de opções em uma coluna diferente em outra planilha. No entanto, a macro está trabalhando apenas na primeira linha.

Eu adicionei Do até porque i = 7 to 1007 não estava indo para next . Agora está expirando e ainda não funciona. Eu acabei de usar uma função para isso, mas está dando problemas a outros usuários no Mac, então estou tentando contornar o Mac sendo difícil.

Devo declarar que algumas das linhas da primeira folha estão em branco.

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

Qualquer ajuda seria apreciada. Isso está me deixando louco.

Yay! Eu percebi isso. Apenas um intervalo faltando.

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

Aqui está o código fixo. Eu também adicionei um if Se a célula do link original estivesse em branco, removeria o hiperlink na nova planilha porque, quando você recorreu às informações, as células que correspondiam a espaços em branco na outra planilha ainda tinham o hiperlink antigo da última vez em que a macro foi aplicada .

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