Sub Macro1()
On Error Resume Next
For j = 6 To Sheets.Count
Sheets(j).Select
For i = 0 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Select
Application.CutCopyMode = False
With Selection
If Left(.ListFillRange, 7) = "[2.xls]" Then
.ListFillRange = Mid(.ListFillRange, 8)
End If
' .LinkedCell = "$L$18"
' .DropDownLines = 8
' .Display3DShading = True
End With
Next
Next
End Sub