Vba 复制/粘贴带有形状的单元格

如何复制形状及其所在的单元格？当我手动复制时，形状跟随单元格，但当我使用宏进行复制时，除了形状之外，我得到了其他所有东西

Cells(sourceRow, sourceColumn).Copy
Cells(targetRow, targedColumn).PasteSpecial

我已经尝试了我能想到的一切。。。但是这个形状就是不动

记录了手动复制/粘贴，这是我得到的：

Range("A1").Select
Selection.Copy
Range("A3").Select
ActiveSheet.Paste

试试这个

---

我会这样做，以避免实际选择单元格：

Sub MoveShape()

  Dim s As Shape
  Dim T, L, celWidth, shpWidth, celHeight, shpHeight As Double
  Dim rng As Range
  Dim ws as Worksheet

  Set s = ws.Shapes(1).Duplicate ''You'll have to get the index of the shape you want to copy 
  Set rng = Range("A3") ''Set this to your target range

  T = rng.Top
  L = rng.Left

  celWidth = rng.Width
  shpWidth = s.Width

  celHeight = rng.Height
  shpHeight = s.Height

  s.Top = T + (celHeight - shpHeight) / 2
  s.Left = L + (celWidth - shpWidth) / 2

End Sub

这将复制您的形状，并将生成的克隆放在目标范围的中心。您可以通过修改

s.Left

和

s.Top

值来更改其在单元格中的位置

---

您现在可以使用

Range（“A3”）.Value=Range（“A1”）.Value

将单元格的实际值复制到您的目标范围

您可以在录制宏时手动执行复制。我只是这样做了，但没有多大帮助。我已经粘贴了问题中录制的宏。录制的代码应该将形状粘贴到单元格

A3

。不是这样吗？应该是这样，但是我必须选择单元格吗？我不能将其直接粘贴到单元格（）或区域（）？是的，您必须将单元格选择为区域/单元格不支持“粘贴”功能是的。我试图在不选择单元格的情况下这样做，因为这样会使我的循环运行得更慢。但如果无法绕过这一点，那么我将尽我所能。谢谢你的帮助！您可以将

Application.screenUpdate=False

设置为增强脚本性能您的解决方案看起来很棒。那正是我要找的！

Range("A1").Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste

Sub MoveShape()

  Dim s As Shape
  Dim T, L, celWidth, shpWidth, celHeight, shpHeight As Double
  Dim rng As Range
  Dim ws as Worksheet

  Set s = ws.Shapes(1).Duplicate ''You'll have to get the index of the shape you want to copy 
  Set rng = Range("A3") ''Set this to your target range

  T = rng.Top
  L = rng.Left

  celWidth = rng.Width
  shpWidth = s.Width

  celHeight = rng.Height
  shpHeight = s.Height

  s.Top = T + (celHeight - shpHeight) / 2
  s.Left = L + (celWidth - shpWidth) / 2

End Sub