Este fórum está sendo desativado

[keshijp]

Boa noite pessoal.
Eu estou adaptando um codigo VBA para criar abas e hiperlinks automaticamente de uma coluna.

Eu consegui adaptar ele e esta funcionando, porem ele soh funciona quando eu deixo o cursor no nome do novo cliente se por acaso o cursor estiver em qualquer outra celula e acionar o vba no botao azul...ele da problema.

1. tem como fazer o excel verificar sempre o novo cliente que for adicionado na coluna A independente de onde o cursor estiver?
2. na planilha modelo existe como ele criar a ABA jah com o nome do NOVO cliente no conteudo da planilha?

segue a planilha, imagem e o codigo

------
Sub add_new_sheet()


Dim sheet_name_to_create As String
Dim sh As Worksheet, nsh As Worksheet ' nsh = sheet_name_to_create
Dim nrng As Range
Dim cont As Worksheet
Dim oRng As Range


sheet_name_to_create = ActiveCell.Value

Set oRng = ActiveCell
Set sh = Sheets("Sheet1")


For rep = 1 To (Worksheets.Count)
If LCase(Sheets(rep).Name) = LCase(sheet_name_to_create) Then

MsgBox "this sheet already exists"
Exit Sub
End If

Next

Sheets("modelo").Visible = True
Sheets("modelo").Copy after:=Sheets(Sheets.Count)

Sheets(ActiveSheet.Name).Name = sheet_name_to_create

sh.Activate
sh.Hyperlinks.Add oRng, "", "'" & sheet_name_to_create & "'!A1", _
"Go to " & sheet_name_to_create, sheet_name_to_create

Set oRng = Nothing

End Sub

[osvaldomp]

Olá, @keshijp .

Experimente o código abaixo.

Código: Selecionar todos

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