Excel Criar múltiplas abas a partir de conteúdo em células com hyperlink ativo.

[Lucas Felipe Rita]

Boa noite pessoal!

 

Estou criando centenas de abas com conteúdo em células através do comando abaixo, porém preciso que ao mesmo tempo que essas abas sejam criadas com os nomes contidos nas células, elas estejam com Hyperlink ativo, cada uma com o seu respectivo link de acordo com o nome.

Sub AddSheets()

'Updateby Extendoffice 20161215

    Dim xRg As Excel.Range

    Dim wSh As Excel.Worksheet

    Dim wBk As Excel.Workbook

    Set wSh = ActiveSheet

    Set wBk = ActiveWorkbook

    Application.ScreenUpdating = False

    For Each xRg In wSh.Range("A1:A7")

        With wBk

            .Sheets.Add after:=.Sheets(.Sheets.Count)

            On Error Resume Next

            ActiveSheet.Name = xRg.Value

            If Err.Number = 1004 Then

              Debug.Print xRg.Value & " already used as a sheet name"

            End If

            On Error GoTo 0

        End With

    Next xRg

    Application.ScreenUpdating = True

End Sub

 

O mais perto que cheguei foi com este comando a seguir, porém ele só cria de uma unica célula, e não de uma seleção, exemplo: de A1:A10.

 

Sub CriaNomeiaHyper()

Dim planBase, planNova As String
Dim plan As Worksheet, flg As Boolean
    planBase = ActiveSheet.Name
    planNova = ActiveSheet.Range("A1").Value

    If planNova = "" Then
        MsgBox "insira em A1 o nome desejado para a nova planilha"
        Exit Sub
    End If
            For Each plan In Worksheets
                If plan.Name Like planNova Then flg = True: Exit For
            Next
If flg = True Then
    MsgBox "já existe a planilha  " & "'" & _
    planNova & "'" & ",  altere o nome desejado"
Else
    Worksheets.Add(after:=Sheets(Sheets.Count)).Name = planNova
    ActiveSheet.Hyperlinks.Add Anchor:= _
    Sheets(planBase).Range("A1"), Address:="", _
        SubAddress:="'" & ActiveSheet.Name _
            & "'!A1", TextToDisplay:=ActiveSheet.Name
End If

End Sub

 

Ficando assim:

 

É possivel criar e linkar da forma que eu desejo?

 

Muito obrigado!

[Visitante]

Experimente:

Sub InserePlanilhaCriaHiperlink()
 Dim ws As Worksheet, c As Range
  Set ws = ActiveSheet
   For Each c In ws.Range("A1:A" & ws.Cells(Rows.Count, 1).End(3).Row)
    If Evaluate("IsError(" & c.Value & "!A1)") = True Then
     Sheets.Add(after:=Sheets(Sheets.Count)).Name = c.Value
     ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
         "'" & c.Value & "'!A1"
    End If
  Next c
End Sub

 

[Lucas Felipe Rita]

1 hora atrás, osvaldomp disse:

Experimente:

Sub InserePlanilhaCriaHiperlink()
 Dim ws As Worksheet, c As Range
  Set ws = ActiveSheet
   For Each c In ws.Range("A1:A" & ws.Cells(Rows.Count, 1).End(3).Row)
    If Evaluate("IsError(" & c.Value & "!A1)") = True Then
     Sheets.Add(after:=Sheets(Sheets.Count)).Name = c.Value
     ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
         "'" & c.Value & "'!A1"
    End If
  Next c
End Sub

 

@osvaldomp Boa tarde!

 

Muito obrigado, o código apresenta um erro, mas ele funciona perfeitamente para o que eu preciso, existe apenas 2 detalhes:

1º : Ele tem limite de criação de abas com hyperlink? Pois preciso fazer isso com o conteúdo de mais de 1400 células.

 

2º : Existe algum complemento no código para que se houver células com conteúdo/nome repetido ele crie a aba, e faça o hyperlink de todas as repetidas no mesmo link? Segue exemplo abaixo:

 

 

Desde Já, muito obrigado Osvaldo.

Abraço

[Visitante]

1 hora atrás, Lucas Felipe Rita disse:

 ... o código apresenta um erro,

Essa informação é genérica e não ajuda.
Informe no mínimo: qual o erro, em que momento ele ocorre, em qual linha do código.

 

1º : Ele tem limite de criação de abas ... ?

Sim, depende da capacidade do computador. Quanto ao código que passei o limite é de 1.048.576 planilhas (coluna A toda preenchida).

 

2º : Existe algum complemento no código para que se houver células com conteúdo/nome repetido ele crie a aba, e faça o hyperlink de todas as repetidas no mesmo link?

Coloque uma cópia do código abaixo no lugar do anterior que passei.

 

 

Sub InserePlanilhaCriaHiperlink()
 Dim ws As Worksheet, c As Range
  Set ws = ActiveSheet
   For Each c In ws.Range("A1:A" & ws.Cells(Rows.Count, 1).End(3).Row)
    If Evaluate("IsError(" & c.Value & "!A1)") = True Then
     Sheets.Add(after:=Sheets(Sheets.Count)).Name = c.Value
    End If
     ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
         "'" & c.Value & "'!A1"
  Next c
End Sub

dica - para responder clique na caixa Responder, localizada abaixo da última postagem, só clique em Citar se necessário.

[Lucas Felipe Rita]

5 horas atrás, osvaldomp disse:

 

Sub InserePlanilhaCriaHiperlink()
 Dim ws As Worksheet, c As Range
  Set ws = ActiveSheet
   For Each c In ws.Range("A1:A" & ws.Cells(Rows.Count, 1).End(3).Row)
    If Evaluate("IsError(" & c.Value & "!A1)") = True Then
     Sheets.Add(after:=Sheets(Sheets.Count)).Name = c.Value
    End If
     ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
         "'" & c.Value & "'!A1"
  Next c
End Sub

dica - para responder clique na caixa Responder, localizada abaixo da última postagem, só clique em Citar se necessário.

Boa tarde!

 

Deu certo, funcionou perfeitamente e o erro de antes não ocorreu, acredito que era algum caractere causava o erro.

 

Tenho mais uma duvida, para o que vou descrever abaixo, é necessário comandos distintos, ou é possível fazer tudo no mesmo? Segue:

 

- Criar as abas de acordo com o conteúdo nas células com hyperlink ativo;

- Copiar a planilha1 (onde há um modelo com formula) e colar em todas as novas abas criadas;

- Ao criar as abas de acordo com o conteúdo das células, copiar a linha inteira de cada e colar de acordo com seu respectivo nome nas novas abas fazendo distinção das palavras chave BUY e SELL que sempre vão estar na coluna D, onde BUY é colada a partir de C4 na nova planilha e SELL é colada a partir de L4.

 

Estou enviando meu arquivo para que você possa dar uma olhada, se não for muito incomodo. Na planilha1, como mencionado, esta o modelo que deve estar em todas as abas, e na aba 2GIVE esta montado do jeito que tentei explicar acima.

 

O que já você já fez me ajudou demais, por favor, se for possível realizar o restante, ira resolver os meu problemas.

 

Desde já, muito obrigado mesmo Osvaldo!!!

Abraço

 

 

 

GERAL.xlsx

[Lucas Felipe Rita]

 

@osvaldomp
Prezado, boa noite!

 

Podes me dizer se é possivel fazer o que mencionei anteriormente? Meu trabalho não esta mais desenvolvendo devido a este impasse e pelo fato de eu ser leigo no assunto. Desde já, agradeço pelo ajuda e atenção!

[Visitante]

Em 06/04/2019 às 18:19, Lucas Felipe Rita disse:

Deu certo, funcionou perfeitamente ...

 

Como a sua demanda original foi resolvida eu sugiro que você encerre este tópico e abra outro para a sua nova demanda.

[Lucas Felipe Rita]

Bom dia,

 

Perfeito, agradeço pela ajuda e atenção até agora, irei fazer o sugerido.