Excel VBA-尝试根据批处理文件列表将300个工作簿范围复制到工作表中，并收到；“范围类的特殊方法失败”；错误

我的代码如下所示工作，但根据工作簿的数量，我遇到了一个错误

pasteRange类的特殊方法失败

。错误发生在任何地方，从3个工作簿导入到目前为止我在测试中得到的最高值是240/300。它一开始很不错，但我现在运气很好，下面列出了大量重复代码

以下是我所做工作的一些关键组成部分：

在组合工作表中，“输入”选项卡上存在宏按钮

“输入”选项卡指定了将特定工作表复制到工作表“数据1”的位置范围

“calc_页面”有一个导入路径列表，该列表可能会根据工作簿所在的文件夹而更改。它们引用了我希望导入到组件2中指定范围的关联工作簿路径

以下是我想要完成的主要步骤：

打开工作簿，从该工作簿引用中以间接方式复制特定范围

将工作簿数据粘贴到“data1”工作表的指定范围内[这取决于列表中的范围]

清除剪贴板并退出工作簿

为范围内的下一个文件启动进程

我在stackoverflow上尝试了多个场景，得到了类似的结果

由于这是一个很长的过程，我将调用以类似方式设置的其他宏的列表。我在下面缩短了代码，但每个宏都有大约45个直接编码的引用

Sub ImportDataFromList()
    Dim App As New Excel.Application 'create new hidden Excel window

    ' Assign active sheet for copying
    Dim wsActive As Worksheet
    Set wsActive = Sheets("data1")

    'Open designated file in new Excel window as read only
    Dim wbImport As Workbook

    Set wbImport = App.Workbooks.Open(Filename:=Worksheets("calc_page").Range("C5"), UpdateLinks:=True, ReadOnly:=True)
    Set wsActive = Sheets("data1")
    'Copy the data to active sheet
    wbImport.Worksheets("Sheet1").Range("A1:N125").Copy
    wsActive.Range([indirect("P5")]).PasteSpecial xlPasteValues  
    App.CutCopyMode = False 'Clears clipboard
    wbImport.Close SaveChanges:=False 'Close new Excel window without saving
    App.Quit 'Quit new Excel window

    Application.Wait (Now + TimeValue("00:00:01"))


    Set wbImport = App.Workbooks.Open(Filename:=Worksheets("calc_page").Range("C6"), UpdateLinks:=True, ReadOnly:=True)
    Set wsActive = Sheets("data1")
    'Copy the data to active sheet
    wbImport.Worksheets("Sheet1").Range("A1:AJ74").Copy
    wsActive.Range([indirect("P6")]).PasteSpecial xlPasteValues  
    App.CutCopyMode = False 'Clears clipboard
    wbImport.Close SaveChanges:=False 'Close new Excel window without saving
    App.Quit 'Quit new Excel window

    Application.Wait (Now + TimeValue("00:00:01"))
End Sub

---

我希望它能够在没有特殊错误的情况下从端到端运行，并成功地从工作簿列表导入所有纯文本值。真的很感谢任何指导，甚至是关于我如何使这项工作的潜在想法。谢谢大家!

欢迎来到SO。无法理解为什么使用新Excel应用程序打开源文件。设置

Application.screenUpdate=False

可以很容易地使源文件几乎不可见。申请等待的目的也不清楚

使用修改后的代码对300个循环和大约250 X 15个单元格的数据范围进行了多次尝试（仅重复打开和关闭一个源文件以供试用），仅需约3分钟即可成功完成任务

Sub ImportDataFromList()
Dim wsActive As Worksheet
Dim wbImport As Workbook
Dim wsCalc As Worksheet
Dim Fname As String, Rw As Long, sSht As String, sRng As String, Trng As String
Dim srcRng As Range, TrgRng As Range
'Dim Tm As Double

Set wsActive = ThisWorkbook.Sheets("data1")
Set wsCalc = ThisWorkbook.Sheets("calc_page")
'Tm = MicroTimer()

Application.ScreenUpdating = False
For Rw = 5 To 305
Fname = wsCalc.Range("C" & Rw) ' Source File Name4
sSht = wsCalc.Range("D" & Rw)  ' Source Sheet name
sRng = wsCalc.Range("E" & Rw)  ' Source Range
Trng = wsCalc.Range("F" & Rw)  ' Target Range.(Only Top Left cell address is used for trial. later resized to the source range)

Set wbImport = Workbooks.Open(Filename:=Fname, UpdateLinks:=True, ReadOnly:=True)
Set srcRng = wbImport.Worksheets(sSht).Range(sRng)
Set TrgRng = wsActive.Range(Trng)
Set TrgRng = TrgRng.Resize(srcRng.Rows.Count, srcRng.Columns.Count)
TrgRng.Cells.Value = srcRng.Cells.Value
wbImport.Close SaveChanges:=False
Next

'Tm = MicroTimer() - Tm
Application.ScreenUpdating = True
'Debug.Print Tm
End Sub

---

欢迎来到SO。无法理解为什么使用新Excel应用程序打开源文件。设置

Application.screenUpdate=False

可以很容易地使源文件几乎不可见。申请等待的目的也不清楚

使用修改后的代码对300个循环和大约250 X 15个单元格的数据范围进行了多次尝试（仅重复打开和关闭一个源文件以供试用），仅需约3分钟即可成功完成任务

Sub ImportDataFromList()
Dim wsActive As Worksheet
Dim wbImport As Workbook
Dim wsCalc As Worksheet
Dim Fname As String, Rw As Long, sSht As String, sRng As String, Trng As String
Dim srcRng As Range, TrgRng As Range
'Dim Tm As Double

Set wsActive = ThisWorkbook.Sheets("data1")
Set wsCalc = ThisWorkbook.Sheets("calc_page")
'Tm = MicroTimer()

Application.ScreenUpdating = False
For Rw = 5 To 305
Fname = wsCalc.Range("C" & Rw) ' Source File Name4
sSht = wsCalc.Range("D" & Rw)  ' Source Sheet name
sRng = wsCalc.Range("E" & Rw)  ' Source Range
Trng = wsCalc.Range("F" & Rw)  ' Target Range.(Only Top Left cell address is used for trial. later resized to the source range)

Set wbImport = Workbooks.Open(Filename:=Fname, UpdateLinks:=True, ReadOnly:=True)
Set srcRng = wbImport.Worksheets(sSht).Range(sRng)
Set TrgRng = wsActive.Range(Trng)
Set TrgRng = TrgRng.Resize(srcRng.Rows.Count, srcRng.Columns.Count)
TrgRng.Cells.Value = srcRng.Cells.Value
wbImport.Close SaveChanges:=False
Next

'Tm = MicroTimer() - Tm
Application.ScreenUpdating = True
'Debug.Print Tm
End Sub

---

嘿，艾哈迈德，我非常感谢你的帮助。它成功了，我现在是一个非常快乐的人。我真是太感谢你了，谢谢。你也让我开心。很高兴听到你这么说，艾哈迈德！嘿，艾哈迈德，我非常感谢你的帮助。它成功了，我现在是一个非常快乐的人。我真是太感谢你了，谢谢。你也让我开心。很高兴听到你这么说，艾哈迈德！