run a macro to extract hyperlinked sheet to new workbook

[dadouza]

I have a workbook of approx 450 sheets, the first sheet of which is a table
of hyperlinks to all the other sheets in the workbook. What I would like to
be able to do is select a column (containing possibly 100 hyperlinks) and
extract all those hyperlinked sheets to a new workbook. I can obviously do it
manually, but it would take some time so I'm looking for something to do it
automatically.
Any help or ideas wold be greatly appreciated.

 

[Gary''s Student]

Here is a sample solution. Workbooks Book1 and Book2 are already opened. We
have a column of hyperlinks in column A of Book1. They were created with:

Insert > Hyperlink

They look like:
Sheet1!A1
Sheet2!A1
..
..
..
The macro:
1. gets the data from the column
2. strips off the cell reference
3. stores the result in an array

The macro then copies the named sheets to Book2.

Sub sheetmover()

Dim shnames() As String
n = Cells(Rows.Count, "A").End(xlUp).Row
ReDim shnames(1 To n)

For i = 1 To n
shnames(i) = Split(Cells(i, 1).Value, "!")(0)
Next

For i = 1 To n
Workbooks("Book1").Sheets(shnames(i)).Copy
After:=Workbooks("Book2").Sheets(1)
Next
End Sub

 

[paul.robinson]

Hi
Here is another solution. The target workbook is created automatically
in the same directory as the original workbook, and will be
overwritten each time the sub runs.

Sub GetLinkedSheets()
Dim Linksworkbook As Workbook
Dim HyperlinkCells As Range
Dim hype As Hyperlink
Application.ScreenUpdating = False
'Named range "HyperlinkCells" in column A
Set HyperlinkCells =
ThisWorkbook.ActiveSheet.Range("HyperlinkCells")
Application.DisplayAlerts = False
Set Linksworkbook = Application.Workbooks.Add
With Linksworkbook
For Each hype In HyperlinkCells.Hyperlinks
hype.Follow
ThisWorkbook.ActiveSheet.Copy before:=.Sheets(1) 'will
be first sheet in Report
Next hype
.SaveAs ThisWorkbook.Path & "\" & "LinksWorkBook.xls"
End With
Application.DisplayAlerts = True
End Sub

regards
Paul