Question

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

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

Answer 1

如果我理解了您的问题，我认为您只需要在粘贴之前在目标表中插入新行。

所以，在下面的代码中，我添加了一行，在循环之前添加了一行，用于粘贴列。

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

Answer 2

以下是一些提示：

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

    Dim rOrigin As Range, rCopyTo As Range

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

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

Answer 3

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

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

您可能要做的另一件事是使用内置的复制功能。

SomeRange.Copy

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

Activesheet.PasteValues

或

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

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

3 个答案: