Schleife externe Verknüpfung
13.03.2018 15:00:39
Mario
ich habe ein kleines Problem, das ich mit meinen bescheidenden VBA Kenntnissen leider nicht lösen kann und hoffe hier Hilfe zu finden. Es geht um folgendes, ich habe zwei Arbeitsmappen mit gleich benannten Arbeitsblättern. Immer wenn diese den gleichen Namen haben sollen externe Verknüpfungen, in dem einen (wbDestination) zum anderen (wbSource), erstellt werden. Der Abgleich klappt, nun hätte ich gerne, was ich nicht hinbekomme, das auch die externen Verknüpfungen per Schleife erstellt werden, damit der Code nicht so lang und unübersichtlich wird.
Anbei der verwendete Code
Sub Import()
Dim strPath As String, strDataName As String, strSearch As String, strFind As
String
Dim wbSource As Workbook, wbDestination As Workbook
Dim wsLoB As Worksheet
Dim i As Integer
Dim raCell As Range
Application.AutomationSecurity = msoAutomationSecurityLow
strPath = ThisWorkbook.Worksheets("Menu").Range("C44")
strDataName = ThisWorkbook.Worksheets("Menu").Range("C43")
Set wbSource = Application.Workbooks.Open(strPath & strDataName,
UpdateLinks:=0, ReadOnly:=False)
Set wbDestination = Application.ThisWorkbook
For i = 7 To wbDestination.Sheets.Count
Set wsLoB = Nothing
On Error Resume Next
Set wsLoB = wbSource.Worksheets(wbDestination.Worksheets(i).Name)
On Error GoTo 0
If TypeName(wsLoB) "Nothing" Then
For Each raCell In wbDestination.Worksheets(i).Range("C55:S55,
C84:S84, C122:S122").Cells
Range("C55").Select
ActiveCell.FormulaR1C1 = "=[strDataName]wsLoB!R46C3"
Range("D55").Select
ActiveCell.FormulaR1C1 = "=[strDataName]wsLoB!R46C4"
bis S55 und für die Zeilen 84 und 122 auch
Next raCell
End If
Next
Application.CutCopyMode = False
wbSource.Close SaveChanges:=False
End Sub
LG
Mario