First of all I dont even know if this is achievable. I have been set a task for work, and have been asked to create this, if at all possible.
An example is attached.
The macro needs to be assigned to one button. I have filled in one row of data (row 6), so before i fill row 7 I need to click the button which would firstly create a new sheet (which i seem to have managed to do) and secondly create a hyperlink which would go in D7 and be linked with the sheet thats just been added.
Follow the same process above, but the hyperlink would need to be placed in D8 then D9, D10 and so on, is this possible to keep the macro all on one button.
Like i said i dont even know if this is possible but if anyone can help, really appreciate it!!!
Hi,
May be something like this:
Code:Sub NewWSHyperlink() Dim NextRow As Long Dim MainSheet As Worksheet Dim NewSheet As Worksheet Application.ScreenUpdating = False Set MainSheet = ActiveSheet NextRow = ActiveSheet.Range(Cells(Rows.Count, 4), Cells(Rows.Count, 4)).End(xlUp).Row + 1 Set NewSheet = Sheets.Add MainSheet.Activate ActiveSheet.Hyperlinks.Add Anchor:=MainSheet.Cells(NextRow, 4), Address:="", SubAddress:= _ NewSheet.Name & "!A1", TextToDisplay:=NewSheet.Name Application.ScreenUpdating = True End Sub
Buran
If you are pleased with a member's answer then use the Scales icon to rate it.
You can try with this code:
Regards,Code:Sub Macro1() Dim sh1 As Worksheet Dim newSh As Worksheet Dim firstFreeRow As Long Set sh1 = ThisWorkbook.Sheets("sheet1") firstFreeRow = sh1.Cells(Rows.Count, "d").End(xlUp).Row + 1 With ThisWorkbook Set newSh = .Sheets.Add(, .Sheets(.Sheets.Count)) newSh.Name = "Sheet" & .Sheets.Count End With sh1.Hyperlinks.Add Anchor:=sh1.Cells(firstFreeRow, "d"), Address:="", _ SubAddress:=newSh.Name & "!A1", TextToDisplay:=newSh.Name & "!A1" End Sub
Antonio
Hi try this code out
Code:Sub Test() Dim LastRow As Long, HypelinkCell As Range With Range("D5:D20000") LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Set HypelinkCell = Range("D" & LastRow + 1) ' Adding sheets Sheets.Add After:=Sheets(Sheets.Count) ' Hyprlinking HypelinkCell.Hyperlinks.Add Anchor:=HypelinkCell, _ Address:="", _ SubAddress:=Sheets(Sheets.Count).Name & "!C21", _ TextToDisplay:=Sheets(Sheets.Count).Name Sheets("Sheet1").Activate End Sub
Люди, питающие благие намерения, как раз и становятся чудовищами.
Regards, «Born in USSR»
Vusal M Dadashev
Baku, Azerbaijan
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks