Sub ListExternalFormulaReferences()
Dim ws As Worksheet, TargetWS As Worksheet, SourceWb As Workbook
If ActiveWorkbook Is Nothing Then Exit Sub
Application.ScreenUpdating = False
With ActiveWorkbook
On Error Resume Next
Set TargetWS = .Worksheets.Add(Before:=.Worksheets(1))
If TargetWS Is Nothing Then ' the workbook is protected
Set SourceWb = ActiveWorkbook
Set TargetWS = Workbooks.Add.Worksheets(1)
SourceWb.Activate
Set SourceWb = Nothing
End If
With TargetWS
.Range("A1").Formula = "Sequence"
.Range("B1").Formula = "Cell"
.Range("C1").Formula = "Formula"
.Range("A1:C1").Font.Bold = True
End With
For Each ws In .Worksheets
If Not ws Is TargetWS Then
ListLinksInWS ws, TargetWS
End If
Next ws
Set ws = Nothing
End With
With TargetWS
.Parent.Activate
.Activate
.Columns("A:C").AutoFit
On Error Resume Next
.Name = "Link List"
On Error GoTo 0
End With
Set TargetWS = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub ListLinksInWS(ws As Worksheet, TargetWS As Worksheet)
Dim cl As Range, cFormula As String, tRow As Long
If ws Is Nothing Then Exit Sub
If TargetWS Is Nothing Then Exit Sub
Application.StatusBar = "Finding external formula references in " & _
ws.Name & "..."
For Each cl In ws.UsedRange
cFormula = cl.Formula
If Len(cFormula) > 0 Then
If Left$(cFormula, 1) = "=" Then
If InStr(cFormula, "[") > 1 Then
With TargetWS
tRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & tRow).Formula = tRow - 1
.Range("B" & tRow).Formula = ws.Name & "!" & _
cl.Address(False, False, xlA1)
.Range("C" & tRow).Formula = "'" & cFormula
End With
End If
End If
End If
Next cl
Set cl = Nothing
Application.StatusBar = False
End Sub
Sub ListLinks()
Dim aLinks As Variant
aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
Sheets.Add
For i = 1 To UBound(aLinks)
Cells(i, 1).Value = aLinks(i)
Next i
End If
End Sub
, ai có cách lấy nhanh chóng chỉ mình với (mình muốn tạo thêm 1 cột nữa để lấy link ra). Thanks
