将范围内容粘贴到3个不同的工作簿中

Question

因此，我尝试使用For Each循环将Range（“ B1：D7”）中的起始工作表的内容复制到Range（“ A1：A3”）中列出的文件中。它会运行完美，直到尝试打开第二个文件并给出错误1004。这是我第一次使用VBA，因此我可以提出任何建议。谢谢

Sub testingLoops()
Dim theRange As Range
Set copyFrom = Workbooks.Open("start.xlsm")
      For Each theRange In Range("A1:A3")
      copyFrom.Sheets("Sheet1").Range("B1:D7").Copy
      Set pasteTo = Workbooks.Open("C:\Users\Joe\Desktop\" + theRange.Value + ".xlsx")
      pasteTo.Sheets("Sheet1").Range("B1:D7").PasteSpecial
      pasteTo.Close
    Next theRange
End Sub

编辑：

这是我的代码，第一个答案仍然得到相同的结果

Option Explicit

Sub testingLoops()

Dim theRange As Range
Dim copyFrom As Workbook
Dim pasteTo As Workbook

Application.DisplayAlerts = False

For Each theRange In Range("A1:A3")

Set copyFrom = ThisWorkbook

copyFrom.Sheets("Sheet1").Range("B1:D7").Copy

Set pasteTo = Workbooks.Open("C:\myFolder\" + theRange + ".xlsx")

pasteTo.Sheets("Sheet1").Range("B1:D7").PasteSpecial

pasteTo.Close

Next theRange

copyFrom.Close

Application.DisplayAlerts = True

End Sub

Answer 1

此外，上述注释...此代码基于您的作品（我更改了目录位置）。它可以帮助您调试自己的...

start.xlsm

还有可能是您从其他工作簿/代码模块运行的代码...

Option Explicit

Sub testingLoops()

    Dim theRange As Range
    Dim copyFrom As Workbook
    Dim pasteto As Workbook

    Application.DisplayAlerts = False
    Set copyFrom = Workbooks.Open("c:\temp\start.xlsm")
    For Each theRange In Range("A1:A3")
        copyFrom.Sheets("Sheet1").Range("B1:D7").Copy
        Set pasteto = Workbooks.Open("C:\temp\" + theRange.Value + ".xlsx")
        pasteto.Sheets("Sheet1").Range("B1:D7").PasteSpecial
        pasteto.Close
    Next theRange
    copyFrom.Close
    Application.DisplayAlerts = True

End Sub

和c：\ temp

Answer 2

因此，经过一番摸索，我终于找到了一种可行的方法。似乎串联文件扩展名是我的问题。为什么？我不确定，但是将.xlsx文件扩展名放在我的范围A1：A3中可以正常工作并保存到所有3个文件中！

Option Explicit

Sub testingLoops()

Dim theRange As Range
Dim pasteTo As Workbook

For Each theRange In Range("A1:A3")

ThisWorkbook.Sheets("Sheet1").Range("B1:D7").Copy

Set pasteTo = Workbooks.Open("C:\myFolder\" & theRange)

pasteTo.Sheets("Sheet1").Range("B1:D7").PasteSpecial

pasteTo.Save

pasteTo.Close

Next theRange

End Sub