运行时错误'-2147417848（80010108）'在循环中处理时随机出现

Question

我有一个包含大约40张工作簿的大型工作簿，超过20个VBA函数（这就是为什么我不想发布所有代码）和20 MB数据。整个机制的目标是每周创建大约200个报告，基于当前数据，然后将每个报告导出为单独的PDF。一切都在一个大循环中工作，因此报告逐一创建。算法复制空工作表与模板，放置值，格式和图，然后将这些表导出为PDF并删除它们，所以问题不在于内存溢出（我想）。

因此，错误在这个大循环的某个迭代中随机发生。有时在第20次迭代，有时在第50次（对于相同的输入数据）。它在某些时候停止并显示此消息：

当我点击Debug按钮时，它会给出：

当我第二次点击Debug按钮时，它会给出：

并且Excel大喊大叫，所以我没有机会调试它。我知道最后一条消息是波兰语（因为我无法更改系统语言），但它说Microsoft Excel停止工作，Windows可以尝试重新打开它。

我尝试将每个.Merge函数更改为其他函数，但在某些.Copy函数上发生错误。据我所知，运行时错误'-2147417848（80010108）'是非常通用的错误，根本没有帮助。

有没有人有类似的问题？任何想法如何解决这个问题？

修改

根据@ mo.h的请求，我发布了发生错误的代码。它只是算法的一部分，所以我不知道这是否有用。

Sub KRS2doArkusza(Spolka As String, KDSstr As String, KRSstr As String)
Dim strona As Integer
Dim lElementow As Integer
Dim Rng As Range
    strona = 2
    lSekcji = 2

    Dim ZakrDane As Range
    Sheets("Raport Hist").Select
    Range("B2").Value = Spolka
    Range("B3").Value = KDSstr
    Range("B4").Value = KRSstr

    ' Wyk 2
    Dim lKol As Integer
    HistSkumKRSDoSklep

    Sheets("Raport Hist").Select
    Range(Range("H23:H24"), Range("H23:H24").End(xlToRight)).Copy
    Sheets("Output" & strona).Select
    Range("B41").PasteSpecial xlPasteAll
    Range("B41").PasteSpecial xlPasteValues
    lKol = Selection.Columns.Count

    Sheets("Raport Hist").Select
    Range(Range("H25"), Range("H25").End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("Output" & strona).Select
    Range("B43").PasteSpecial xlPasteAll
    Range("B43").PasteSpecial xlPasteValues

    For i = 2 To lKol + 1
        Set Rng = ActiveSheet.Range(Cells(40, i), Cells(42, i))
        Rng.Merge
    Next i

    Range(Range("B40:B42"), Range("B40:B42").End(xlToRight)).Select
    obramowanie

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Range(Range("B43"), Range("B43").End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    obramowanie

    Sheets("Raport Hist").Select
    ActiveSheet.Shapes("Wykres 3").Copy
    Sheets("Output" & strona).Select
    Range("C63").Select
    ActiveSheet.Paste
    ActiveChart.Parent.Name = "Wyk 2"

    ActiveSheet.Shapes("Wyk 2").Height = ActiveSheet.Range("F63:F102").Height
    ActiveSheet.Shapes("Wyk 2").Width = ActiveSheet.Range("C1:N1").Width

    ' Wyk 1
    Hist_KRS

    Sheets("Raport Hist").Select
    Range(Range("D1:F1"), Range("D1:F1").End(xlDown)).Copy
    Sheets("Output" & strona).Select

    Range("B15").PasteSpecial xlPasteAll
    Range("B15").PasteSpecial xlPasteValues

    Sheets("Raport Hist").Select
    Range(Range("E1"), Range("E1").End(xlDown)).Copy
    Sheets("Output" & strona).Select
    Range("D15").PasteSpecial xlPasteFormats

    Range("B14:B15").Merge
    Range("C14:C15").Merge
    Range("D14:D15").Merge

    Range("B14:D15").Select
    obramowanie

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Range(Range("B16:D16"), Range("B16:D16").End(xlDown)).Select
    obramowanie

    Sheets("Raport Hist").Select
    ActiveSheet.Shapes("Wykres 2").Copy
    Sheets("Output" & strona).Select
    Range("F14").Select
    ActiveSheet.Paste
    ActiveChart.Parent.Name = "Wyk 1"

    ActiveSheet.Shapes("Wyk 1").Height = ActiveSheet.Range("F14:F33").Height
    ActiveSheet.Shapes("Wyk 1").Width = ActiveSheet.Range("F1:O1").Width

    ' Tytuły
    Sheets("Output" & strona).Select
    ActiveSheet.Shapes("Wyk 1").Select
    Range("B11").Value = ActiveChart.ChartTitle.Text
    ActiveChart.ChartTitle.Delete

    ActiveSheet.Shapes("Wyk 2").Select
    Range("B37").Value = ActiveChart.ChartTitle.Text
    ActiveChart.ChartTitle.Delete

End Sub