Add break external links in existing vba loop

[arcaidius]

Good afternoon,

I have an existing code that copies all sheets from all workbooks in a folder. I am having trouble adding a code into this loop to break all external links in the paste destination before closing the workbooks that are copied. Can anyone help me out? Some workbooks have multiple sheets some only one. Here is my code below:

Sub Button2_Click()



Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False

Application.DisplayAlerts = False

directory = "M:\NCR & Metrics Worksheets\Metrics\Houston Metrics Workbook\Exports For Current Month\Calculation Process\Calculators\"

fileName = Dir(directory & "*.xlsx")



Do While fileName <> ""

Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets

total = Workbooks("Macro Test 2.xlsm").Worksheets.Count

Workbooks(fileName).Worksheets(sheet.Name).Copy _

after:=Workbooks("Macro Test 2.xlsm").Worksheets(total)

Next sheet

‘Need to break links before closing.

Workbooks(fileName).Close

fileName = Dir()

Loop



Application.ScreenUpdating = True

Application.DisplayAlerts = True



End Sub

 

[arcaidius]

Good thing I was able to restore previous versions of my documents....

So I put this code in the Loop and added

SaveChanges = False

to my Close workbooks line but it saved all the workbooks after breaking links. AHH!!!!!

Dim Links As Variant
Links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
For i = 1 To UBound(Links)
ActiveWorkbook.BreakLink _
    Name:=Links(i), _
    Type:=xlLinkTypeExcelLinks
Next i

I stuck it right after these lines:

Do While fileName <> ""
Workbooks.Open (directory & fileName)

I am thinking maybe I should go a different route... Like print the sheets I need to PDF maybe, not sure.

The workbooks in the folder I am copying sheets from get some data from other workbooks, and do some calculations with formulas, some of them using Indirect so that if the link gets broken somehow I can see what its suppose to link to and fix it.

Can I Loop through each workbook, name the specific sheets I want to copy, Copy some ranges pasting values only and other ranges formulas? I was trying something like that originally but could only get it to work for one sheet.

 

[arcaidius]

Guess solved my problem by just copy and pasting each range as value only or with the formulas as needed. a lot more code but it works.

Copy and paste values:

    Workbooks("Calculate1.xlsx").Worksheets("Sheet1").Range("B9:B69").Copy
    Workbooks("Report 1.xlsx").Worksheets("Table").Range("B9").PasteSpecial Paste:=xlPasteValues

Copy and paste with formulas:

    Workbooks("Calculate2.xlsx").Worksheets("Sheet1").Range("H3:I50").Copy Workbooks("Report 1.xlsx").Worksheets("Summary Data").Range("H2")