Vba 更改宏以插入信息，而不仅仅是复制

这就是我现在用来拉列并将它们粘贴到适当的eorder中的内容。我希望发生两件事。首先，这个宏只是粘贴信息；我想插入信息行，因为我在列的末尾有公式是目标工作表。只需粘贴，信息就会粘贴到包含公式的单元格上。第二，上面的宏没有任何边界；我已设置了目标图纸，但粘贴时会丢失所有边框（即使母版图纸和目标图纸有边框）。也许插入会解决这个问题-我不确定。但无论如何，我想插入而不是粘贴。

从您的代码中，很明显，您只是从一张表中读取值，然后将它们写入另一张表中。因此，要读取公式生成的值，请使用.TEXT而不是.VALUE

Sub test4()

Dim LCopyToRow As Long
Dim LCopyToCol As Long
Dim arrColsToCopy
Dim c As Range, x As Integer

On Error GoTo Err_Execute


arrColsToCopy = Array(1, 25, 3) 'which columns to copy ?
Set c = Sheets("MasterList").Range("Y5")  'Start search in Row 5
LCopyToRow = 2 'Start copying data to row 2 in Sheet4

While Len(c.Value) > 0

    'If value in column Y ends with "2188", copy to Sheet4
    If c.Value Like "*2188" Then

        LCopyToCol = 1
        For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)

            Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).Value = _
                           c.EntireRow.Cells(arrColsToCopy(x)).Value

           LCopyToCol = LCopyToCol + 1

        Next x

        LCopyToRow = LCopyToRow + 1 'next row

    End If

    Set c = c.Offset(1, 0)

Wend

'Position on cell A5
Range("A5").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
        MsgBox "An error occurred."

End Sub

您可以做的另一件事是使用内置的Copy函数

myValue = someRange.Text   'reads the output text by the formula but .TEXT is read only so be careful

然后转到要粘贴的工作表并执行以下操作

SomeRange.Copy

或

---

如果我理解你的问题，我想你只需要在粘贴前在目的地工作表中插入一个新行

因此，在下面的代码中，我添加了一行，在粘贴列的循环之前添加一行

Activesheet.PasteSpecial (use options here to copy formats and so on)

让我知道这看起来是否正确，或者我是否误解了你

更新

若要复制格式，请在复制值的行之后添加以下两行：

If c.Value Like "*2188" Then

    LCopyToCol = 1

'--> Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=xlDown

    For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)

---

以下是给你的一些提示：

此代码为我插入和复制以下格式：

c.EntireRow.Cells(arrColsToCopy(x)).Copy
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone

---

我想我们中的一方或双方都感到困惑。我的工作簿有一张母版纸，后面有@30张单独的工作表。母版纸上根本没有公式；这只是原始数据。每个单独的工作表在某些列的底部都有总计和公式。当我使用上面的宏时，它会将主工作表中的数据放入单个工作表中，但如果信息包含的太多，则会用公式覆盖单元格。我希望它不只是在所有单元格（即带有我的公式的单元格）上插入信息，而是将数据行插入到各个工作表中。目标工作表上是否有现有数据，或者只是公式？如果它们的格式都相似，则可以在公式上方插入值。至于边框不显示的原因：看起来您已经在目标工作表上应用了边框-上面的宏不应该影响它们。这几乎正是我想要做的。它正确传输信息并插入，以保持目标中的公式不变。但是，当它插入新行时，它会从插入位置正上方的行中获取格式，该行包含所有列标题。我仍然需要检查并调整所有数据单元格的大小，因为它们没有从源代码中继承格式。我还更新了代码以演示如何复制格式。我还没有测试它，所以您可能需要对它进行一些修改。如果此答案解决了您的问题，请单击答案左侧的复选标记将其标记为正确。谢谢，我想我做错了什么。我想“PastSpecial”应该有一个“e”在里面？当我把它放进去时，我得到了表达式结束错误和/或操作错误。我把vba的格式弄乱了吗？不，是我的错。你是对的，它应该是带有“e”的

PasteSpecial

。另外，第三行是完全不需要的，所以我删除了它。你能再试一次代码吗？实际上，这次我测试了它：）在第二行的两个实例中，我一直得到“：”的表达式错误。

c.EntireRow.Cells(arrColsToCopy(x)).Copy
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone

    Dim rOrigin As Range, rCopyTo As Range

    Set rCopyTo = Selection
    Set rOrigin = Range("A2")

    rCopyTo.Insert xlShiftToRight, rOrigin.Copy
    Application.CutCopyMode = False