复制 for 循环找到的范围并粘贴到另一张纸上

Question

我有一个宏，它接受输入并找到具有匹配名称的工作表。 从那里它循环遍历第一行（标题）以查找与第二个输入匹配的列。

我想复制整个列并将其粘贴到不同的工作表上。

当我运行代码时，它会一直工作，直到复制/粘贴到我得到的位置

“运行时错误 '1004' 应用程序定义或对象定义错误

用评论指出。

SDay = Sheets("Heat Map").Range("C1").Value
STime = Sheets("Heat Map").Range("C2").Value

Worksheets(SDay).Activate

For i = 2 To 17
    If ActiveSheet.Cells(1, i).Value = Sheets("Heat Map").Range("C2").Value Then
        ActiveSheet.Range(Cells(2, i), Cells(19, i)).Select ' Error is here
        Selection.Copy
    End If
Next i

Sheets("Heat Map").Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  xlNone, SkipBlanks:=False, Transpose:=False

Sheets("Heat Map").Activate

Answer 1

这是一个常见的错误，但您不应该使用 copy/paste 或activate或activesheet 。 这已经被讨论了数千次。 检查这个关于如何避免它的好答案： How to avoid using Select in Excel VBA

主要原因是您现在永远不会知道“ActiveSheet”是什么。 想象一下，如果由于某种原因无法激活工作表。 通过粘贴一些不应该去的地方，你会破坏工作簿的其余部分。 始终创建工作簿和工作表对象并使用它们。

无论如何，尝试将一个范围分配给另一个。 只需确保两者具有相同的尺寸（长度、宽度）。 因此，不要复制然后粘贴，只需执行类似的操作

Dim heatMap as Worksheet

Set heatMap = ThisWorkbook.Worksheets("Heat Map")
Set otherSheet = ThisWorkbook.Worksheets("Your other sheet")

otherSheet.Range(otherSheet.Cells(2, i), otherSheet.Cells(19, i))  = heatMap.Range(heatMap.Cells(2, i), heatMap.Cells(19, i))

我没有测试此代码，因此如果它失败，请尝试先尝试复制单个单元格的范围（带有硬编码的行和列），然后从那里开始工作，从而降低速度。