Hi guys,
I stuck with a problem where I hope you can help.
Situation:
I added a macro that allows me to import excel worksheets from other workbooks.
The imported sheets have formulas in cells "B6:CX49" still referencing to another sheet in the workbook from where I have imported the sheets from.
Example from the imported sheets:
Below the code how i import the worksheets:
Hope you can help,
Thanks
I stuck with a problem where I hope you can help.
Situation:
I added a macro that allows me to import excel worksheets from other workbooks.
The imported sheets have formulas in cells "B6:CX49" still referencing to another sheet in the workbook from where I have imported the sheets from.
Example from the imported sheets:
- =SUMIFS('[AB_.xlsm]ABC'!$AE:$AE;'[AB_.xlsm]ABC'!$D:$D;$A3;'[AB_.xlsm]ABC'!$V:$V;$A8; '[AB_.xlsm]ABC'!$U:$U;AM4)
- =SUMIFS(ABC!$AE:$AE;ABC!$D:$D;$A3;ABC!$V:$V;$A8; ABC!$U:$U;AM4)
Below the code how i import the worksheets:
Dim sheet As String
Dim TabList As String
Dim i As Long
Dim ws As Worksheet
Dim lastsheet As String
Dim directory As String, fileName As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
TabList = ""
lastsheet = "template"
directory = ""
fileName = ""
i = 4
sheet = ActiveSheet.Name
Workbook = ActiveWorkbook.Name
For Each ws In Worksheets
TabList = TabList & ws.Name & vbCr
Next ws
lastRow = ThisWorkbook.Sheets(ActiveSheet.Name).Range("A" & Rows.Count).End(xlUp).Row
Set Rng = ThisWorkbook.Sheets(ActiveSheet.Name).Range("A" & "4:" & "A" & lastRow)
For Each cell In Rng
If cell.Value <> "" And InStr(1, TabList, cell.Value) = 0 Then
If directory <> ThisWorkbook.Sheets(sheet).Range("B" & i).Value Or fileName <> ThisWorkbook.Sheets(sheet).Range("C" & i).Value Then
directory = ThisWorkbook.Sheets(sheet).Range("B" & i).Value
fileName = ThisWorkbook.Sheets(sheet).Range("C" & i).Value
Workbooks.Open (directory & fileName)
Workbooks(fileName).Worksheets(cell.Value).Copy _
after:=Workbooks(Workbook).Worksheets(lastsheet)
lastsheet = cell.Value
Else
Workbooks(fileName).Worksheets(cell.Value).Copy _
after:=Workbooks(Workbook).Worksheets(lastsheet)
lastsheet = cell.Value
End If
End If
i = i + 1
Next cell
On Error Resume Next
Workbooks(fileName).Close
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Sheets(sheet).Activate
Hope you can help,
Thanks
