Hallo zusammen,

leider habe ich ein Problem mit einem VBA-Code, der bisher jahrelang fehlerfrei gelaufen ist. Auf einmal dauert das Durchführen des Makros nicht mehr wie bisher ca. 60 Sekunden, sondern ca. 1 Stunde. Ich kann mir das nicht erklären und wäre für jede Hinweise/Ideen dankbar.
Die Excel Version ist Excel für M365. Versteckte ActiveX-Elemente gibt es nicht, auch keine Shape-Objekte.

Dies ist der Code:

Sub ImportVariante1()

Dim WBDealFile As Variant
Dim i As Integer
Dim iCol As Integer
Dim SHLfreq As String
Dim WBFileName As String
Dim WBFilePath As String
Dim AnaSheetName As String
Dim objFSO As Object

CheckWBTrigger = 1

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.CutCopyMode = False
.EnableEvents = False
End With

ThisWorkbook.Worksheets("Import WB").Select

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)

With FilePicker
.Title = "Selektion der WB"
.AllowMultiSelect = False
.Filters.Add "Excel-Dateien", "*.xl*", 1

If .Show = True Then
WBDealFile = .SelectedItems(1)
Else
MsgBox "Vorgang abgebrochen."
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.CutCopyMode = True
.EnableEvents = True
End With
Exit Sub
End If

End With

If Left(WBDealFile, 4) > "http" And Left(Left(WBDealFile, InStrRev(WBDealFile, "\", -1)), 2) > "\\" Then

Set objFolder = objFSO.GetFolder(Left(WBDealFile, InStrRev(WBDealFile, "\", -1)))
Set fs = objFSO.GetDrive(Left(Left(WBDealFile, InStrRev(WBDealFile, "\", -1)), 2))

WBFileName = Right(WBDealFile, Len(WBDealFile) - InStrRev(WBDealFile, Application.PathSeparator))
WBFilePath = fs.Sharename & Mid(objFolder, 3, Len(objFolder)) & "\"

Else

If Left(WBDealFile, 5) = "https" Then

WBDealFile = Replace(WBDealFile, "https", "http")

End If

If Left(Left(WBDealFile, InStrRev(WBDealFile, "\", -1)), 2) = "\\" Then

WBFileName = Right(WBDealFile, Len(WBDealFile) - InStrRev(WBDealFile, "\"))
WBFilePath = Left(WBDealFile, InStrRev(WBDealFile, "\"))

Else

WBFileName = Right(WBDealFile, Len(WBDealFile) - InStrRev(WBDealFile, "/"))
WBFilePath = Left(WBDealFile, InStrRev(WBDealFile, "/"))

End If

End If

AnaSheetName = Tabelle1.Name

ThisWorkbook.Worksheets("Import WB").Select
Cells(55, 2).Select
Selection.Offset(0, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Stammdaten'!" & "R18C9"


ThisWorkbook.Worksheets("Import WB").Select

Cells(57, 49).Select
Cells(57, 49).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!s_start_mietcashflow"

Cells(57, 37).Select

i = 11
iCol = 0

Do While i = 22 And iCol = 10

Selection.Offset(0, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Marktwert'!" & "R27C" & i
Selection.Offset(1, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Marktwert'!" & "R28C" & i

i = i + 1
iCol = iCol + 1

Loop

Cells(55, 56).Select

i = 11
iCol = 0

Do While i = 22 And iCol = 10

Selection.Offset(0, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R18C" & i & "+'" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R25C" & i
Selection.Offset(1, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R68C" & i
Selection.Offset(2, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R49C" & i
Selection.Offset(3, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R50C" & i
Selection.Offset(4, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R51C" & i
Selection.Offset(5, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R14C" & i
Selection.Offset(6, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R48C" & i
Selection.Offset(7, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R74C" & i
Selection.Offset(8, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R13C" & i
Selection.Offset(9, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R17C" & i
Selection.Offset(10, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R24C" & i
Selection.Offset(11, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R71C" & i
Selection.Offset(12, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R72C" & i
Selection.Offset(88, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R56C" & i
Selection.Offset(101, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R57C" & i
Selection.Offset(102, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R61C" & i
Selection.Offset(105, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R70C" & i
Selection.Offset(106, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R52C" & i
Selection.Offset(107, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R45C" & i
Selection.Offset(108, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Konten'!" & "R44C" & i

i = i + 1
iCol = iCol + 1

Loop

Cells(90, 75).Select

i = 11
iCol = 0

Do While i = 22 And iCol = 10

Selection.Offset(0, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Finanz.'!" & "R85C" & i

i = i + 1
iCol = iCol + 1

Loop

Cells(125, 75).Select

i = 11
iCol = 0

Do While i = 22 And iCol = 10

Selection.Offset(0, iCol).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Finanz.'!" & "R119C" & i

i = i + 1
iCol = iCol + 1

Loop


Cells(87, 73).Select
Selection.Offset(0, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!f_darlehensart_1"
Selection.Offset(0, 3).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Finanz.'!" & "R66C10"

Cells(122, 73).Select
Selection.Offset(0, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!f_darlehensart_2"
Selection.Offset(0, 3).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Finanz.'!" & "R100C10"

Application.CalculateFull

ThisWorkbook.Worksheets("Import WB").Select

SHLfreq = Cells(53, 35).Value

Cells(55, 2).Select


Selection.Offset(1, 1).FormulaR1C1 = ""
Selection.Offset(2, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R172C29"
Selection.Offset(3, 1).FormulaR1C1 = ""
Selection.Offset(4, 1).Value = "='Import WB'!" & "R53C47" & "+" & "'" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R15C13"
With Selection.Offset(4, 1)
.Value = .Value
End With
Selection.Offset(5, 1).FormulaR1C1 = "='Import WB'!" & "R53C48"
With Selection.Offset(5, 1)
.Value = .Value
End With
Selection.Offset(6, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Stammdaten'!" & "R29C15"
Selection.Offset(7, 1).FormulaR1C1 = ""
Selection.Offset(13, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R243C29" & "/'Import WB'!" & "R87C3"
Selection.Offset(14, 1).FormulaR1C1 = "=VLOOKUP(""03.01"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,8,FALSE)"
Selection.Offset(15, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "TAX'!" & "R31C10"
Selection.Offset(16, 1).FormulaR1C1 = "=VLOOKUP(""02"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)-VLOOKUP(""02.03"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)-VLOOKUP(""02.04"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)-VLOOKUP(""02.05"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)-VLOOKUP(""02.12"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)+VLOOKUP(""03"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)-VLOOKUP(""03.01"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)-VLOOKUP(""03.02.07"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C10:R112C21,12,FALSE)"
Selection.Offset(17, 1).FormulaR1C1 = ""
Selection.Offset(18, 1).FormulaR1C1 = "=VLOOKUP(""04.01"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,8,FALSE)"
Selection.Offset(19, 1).FormulaR1C1 = "=VLOOKUP(""02.12"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)+VLOOKUP(""03.02.07"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C10:R112C21,12,FALSE)"
Selection.Offset(20, 1).FormulaR1C1 = "=SUM('" & WBFilePath & "[" & WBFileName & "]" & "IG'!R30C11:R33C11)"
Selection.Offset(21, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R15C13"
Selection.Offset(22, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R43C10" & "+" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C10"
Selection.Offset(23, 1).FormulaR1C1 = "=(" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C10" & "+'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C11" & "+'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C12" & ")" & "/" & "(" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R43C10" & "+" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C10" & "+" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C11" & "+" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R44C12" & ")"
Selection.Offset(24, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R41C10"
Selection.Offset(25, 1).FormulaR1C1 = "=VLOOKUP(""02.12"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)+VLOOKUP(""03.02.07"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C10:R112C21,12,FALSE)"
Selection.Offset(26, 1).FormulaR1C1 = "=-VLOOKUP(""05.01"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C21,13,FALSE)" & "/((" & "'" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R15C13" & "-" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R41C10" & ")*" & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R16C10" & ")"
Selection.Offset(27, 1).FormulaR1C1 = "=IF(AND('" & WBFilePath & WBFileName & "'!v_Investitionstyp_index" & "=2, '" & WBFilePath & WBFileName & "'!v_invest_typ_index" & "=2), 2, 1)"
Selection.Offset(28, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "GI'!" & "R25C13"

Range(Cells(55, 3), Cells(55, 7)).Select
Selection.Copy
Cells(55, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Cells(55, 11).Select

Selection.Offset(3, 1).FormulaR1C1 = "=IF('" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R36C10" & "=""Fair-Value"",0," & "'" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R37C10" & ")"
Selection.Offset(5, 1).FormulaR1C1 = "=(VLOOKUP(""02.03"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C23,15,FALSE)+VLOOKUP(""02.04"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C23,15,FALSE))" & "/" & "'" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R15C13"
Selection.Offset(7, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R25C10"
Selection.Offset(8, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R24C10"
Selection.Offset(10, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R16C10"
Selection.Offset(14, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R28C10"
Selection.Offset(22, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R18C10"

Range(Cells(55, 3), Cells(55, 7)).Select
Selection.Copy
Cells(55, 22).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Cells(55, 21).Select

Selection.Offset(2, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R50C10"
Selection.Offset(4, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "GI'!" & "R28C21"
Selection.Offset(5, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "GI'!" & "R29C21"
Selection.Offset(6, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Stammdaten'!" & "R21C9" & "&"", ""&" & "'" & WBFilePath & "[" & WBFileName & "]" & "Stammdaten'!" & "R22C12"
Selection.Offset(8, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "GI'!" & "R26C16"
Selection.Offset(9, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Mgtm Sum'!" & "R30C8" & "/" & "'" & WBFilePath & "[" & WBFileName & "]" & "Mgtm Sum'!" & "R30C10"
Selection.Offset(10, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!v_flaecheneinheit_text"
Selection.Offset(11, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!avdb_vermietbare_flaeche"
Selection.Offset(12, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R41C10"
Selection.Offset(13, 1).FormulaR1C1 = "=(VLOOKUP(""02.13"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C23,13,FALSE)+VLOOKUP(""02.14"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C23,13,FALSE)+VLOOKUP(""02.15"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C23,13,FALSE)+VLOOKUP(""02.16"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R112C23,13,FALSE))"
Selection.Offset(14, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "IG'!" & "R20C11"
Selection.Offset(15, 1).FormulaR1C1 = "=VLOOKUP(""06"",'" & WBFilePath & "[" & WBFileName & "]" & "GI'!R37C9:R200C23,13,FALSE)"
Selection.Offset(16, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!gb_afa_methode"
Selection.Offset(17, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!gb_nutzungsdauer"
Selection.Offset(18, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Kennzahlen'!" & "R198C29"
Selection.Offset(21, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!avdb_baujahr"
Selection.Offset(22, 1).FormulaR1C1 = "='" & WBFilePath & WBFileName & "'!v_typ_text"
Cells(55, 94).Select
For i = 1 To 11
Selection.Offset(0, i).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R57C[-84]"
Next i

Set WBDealFile = Nothing

Cells(2, 17).Value = WBFileName
Cells(3, 17).Value = WBFilePath
Cells(1, 1).Select

Application.Calculate

ThisWorkbook.Worksheets("Tracer").Select
Cells(10, 6).Value = "Share Deal"
Cells(11, 6).Value = "AD-Exit"
Cells(10, 7).Value = "Asset Deal"
Cells(11, 7).Value = "AD-Exit"
Cells(1, 1).Select

ThisWorkbook.Worksheets("Check WB").Select
Cells(6, 3).Value = "Share Deal"
Cells(6, 4).Value = "AD-Exit"

Application.Calculate

Call Check_WB_Data_Filler


Application.Calculate

ThisWorkbook.Worksheets("Import WB").Select
If Cells(86, 14).Value > 0 Then
Cells(10, 12).Select
Selection.Offset(0, 0).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R25C10"
Selection.Offset(1, 0).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R24C10"
Selection.Offset(2, 0).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R16C10"
Selection.Offset(5, 0).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "Tax'!" & "R28C10"

Sheets("Import WB").Range("V74").Value = Sheets("Import WB").Range("L60").Value

Range(Cells(62, 12), Cells(75, 12)).Select
Selection.ClearContents
Cells(59, 12).Select
Selection.ClearContents
End If

If Cells(86, 14).Value = 2 Then
Range("L61").ClearContents
End If

Cells(56, 110).Select
x = 0
y = 8
For i = 1 To 24
Selection.Offset(x, 0).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "TER'!" & "R" & y & "C5"
Selection.Offset(x, 1).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "TER'!" & "R" & y & "C6"
Selection.Offset(x, 2).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "TER'!" & "R" & y & "C7"
Selection.Offset(x, 3).FormulaR1C1 = "='" & WBFilePath & "[" & WBFileName & "]" & "TER'!" & "R" & y & "C8"
x = x + 1
y = y + 1
Next i

Application.Calculate

Cells(11, 7).Value = Tabelle5.Cells(54, 3).Value
Cells(11, 8).Value = Tabelle5.Cells(54, 4).Value
Cells(11, 9).Value = Tabelle5.Cells(54, 5).Value
Cells(1, 1).Select

ThisWorkbook.Worksheets("Import WB").Select
Cells(1, 1).Select

Sheets("Import WB").Select
Range("C84:G84").Select
Selection.Copy
Range("C85").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Check WB").Select
Range("AW3:AY7").Select
Selection.Copy
Range("B8").Select
Sheets("Import WB").Select
Range("G11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F52").Select
ThisWorkbook.Worksheets("Import WB").Select
Range("d52").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("d52").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Cells(1, 1).Select

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.CutCopyMode = True
.EnableEvents = True
End With

CheckWBTrigger = 0

End Sub