Excel VBA将特殊的不相交范围从一个工作簿粘贴到另一个工作簿

Question

这是我的第一篇有关堆栈溢出的文章，已经对我有很大帮助-希望这次也是如此。 我绝对停留在一个简单的复制粘贴宏上。 我试图遍历特定文件夹中的所有xlsx文件，一个接一个地打开它们，并始终复制相同的4个单元格内容。 这4个值应粘贴到运行宏但已转置的原始工作簿中。

据我了解，我需要使用.copy .pastespecial命令，因为我想转置，因此无法使用范围。 我还了解到需要在关闭工作簿之前进行粘贴，因为否则关闭文件后剪贴板将清空。

宏正确循环所有文件（在适当的时间打开和关闭它们），并正确评估if语句。 但是，.Copy实际上似乎并未将任何内容复制到剪贴板，因此也不会粘贴任何内容。 但是，我也没有使用以下代码弹出任何错误消息。

Sub Copypaste()

Dim i As Integer
Dim path As String
Dim fname As String
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Worksheets("Sheet name")

'Define path of active excel workbook 
path = ActiveWorkbook.path
'Get list of all templates (xlsx)
templates = GetFiles(path & "\Output", "*.xlsx")
'Loop through all templates
On Error GoTo 0
For i = LBound(templates) To UBound(templates)
'First filename from list of all files in Output folder taken and opened
fname = CStr(templates(i))
Workbooks.Open Filename:=path & "\Output\" & fname
If ActiveWorkbook.Worksheets("Copy worksheet").Range("M40") <> 0 Or _  
ActiveWorkbook.Worksheets("Copy worksheet").Range("M45") <> 0 Or _ 
ActiveWorkbook.Worksheets("Copy worksheet").Range("M73") <> 0 Then

ActiveWorkbook.Worksheets("Copy worksheet").Range("F4", "M40", "M45", "M73").Copy
ws1.Range("B5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If
Workbooks(fname).Activate
ActiveWorkbook.Close savechanges:=False

Next i
End Sub

到目前为止，我只能将值粘贴为连续范围，可以吗？ 在理想情况下，我会将前三个单元格值粘贴到3个相邻的单元格中，然后将最后一个值（来自“ M73”）粘贴到另一个单元格中。

如果可以使用，我想扩展代码，以便粘贴到文件中的新值不会覆盖以前的值，即，并非所有粘贴都发生在B5中，而是在下一个空行中。 现在还不知道该怎么做，但这是我想的下一个问题，一旦我得到您的帮助，便解决了这个问题。

非常感谢！

Answer 1

我认为您不能复制不在同一行或同一列中的不相交的范围。 尝试在Excel中复制范围F4,M40,M45,M73 ，看看是否出现错误。 我的猜测是，它将适用于M40,M45,M73但不适用于F4,M40

如果您只复制这4个单元格，则可以执行以下操作

Set rngFrom = ActiveWorkbook.Worksheets("Copy worksheet").Range("F4,M40,M45,M73")
Set rngTo = ActiveWorkbook.Worksheets("Sheet name").Range("B5:B8")

For i = 1 To 4
    rngTo(i).Value = rngFrom.Areas(i).Value ' rngTo(i) is short for rngTo.Cells(i, 1)
Next