run a macro to extract hyperlinked sheet to new workbook
 

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.

run a macro to extract hyperlinked sheet to new workbook
 

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

--
Gary''s Student - gsnu200781


"dadouza" wrote:

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.

run a macro to extract hyperlinked sheet to new workbook
 

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 befo=.Sheets(1) 'will
be first sheet in Report
Next hype
.SaveAs ThisWorkbook.Path & "\" & "LinksWorkBook.xls"
End With
Application.DisplayAlerts = True
End Sub

regards
Paul

On Apr 28, 2:06*pm, Gary''s Student
wrote:
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

--
Gary''s Student - gsnu200781



"dadouza" wrote:
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.- Hide quoted text -

- Show quoted text -