VBA复制目的地但作为值

时间:2015-01-29 07:30:56

标签: excel vba excel-vba excel-2007 excel-2013

我正在尝试使用“复制目的地”将数据从一个文档传输到另一个文档,因为我想避免使用剪贴板,但我希望它停止使用它进行格式化...

Dim Sheet As Worksheet
Dim FoundLocationSheet As Boolean
Dim n As Long
Dim AllSheet As Worksheet
Set AllSheet = Sheets("Main")

'Transfer data
For n = 1 To AllSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If AllSheet.Cells(n, 1) = "TiTle" Then
        With Sheets(AllSheet.Cells(n - 1, 1).Value)
            AllSheet.Cells(n, 1).CurrentRegion.Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
        End With
    End If
Next n

宏可能会从A20:L40提取数据并将其放入A15:L35 ...

我一直在用AllSheet.Cells(n, 1).CurrentRegion.Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)尝试很多不同的事情,但是无法弄清楚如何让它发挥作用......

工作表的大小意味着清算格式需要太长时间:/

有什么想法吗?

2 个答案:

答案 0 :(得分:1)

由于您希望避免剪贴板而只复制值,因此您可以使用Value属性而不是Range.Copy

进行分配

像这样的东西

Sub Demo()
    Dim Sheet As Worksheet
    Dim FoundLocationSheet As Boolean
    Dim n As Long
    Dim rSource As Range
    Dim rDest As Range
    Dim AllSheet As Worksheet

    Set AllSheet = Sheets("Main")

    'Transfer data
    For n = 1 To AllSheet.Cells(Rows.Count, 1).End(xlUp).Row
        If AllSheet.Cells(n, 1) = "TiTle" Then
            With Worksheets(AllSheet.Cells(n - 1, 1).Value)
                ' Reference the range to be copied
                Set rSource = AllSheet.Cells(n, 1).CurrentRegion
                ' Reference the Top Left cell of the destination range
                ' and resize to match source range
                Set rDest = _
                  .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 0) _
                  .Resize(rSource.Rows.Count, rSource.Columns.Count)
                ' Copy values
                rDest.Value = rSource.Value
            End With
        End If
    Next n
End Sub

答案 1 :(得分:0)

您可以将数据复制到任何阵列,然后从阵列复制到目标。执行此操作的代码很短且效率极高。注意:源必须有多个单元格。

' Create dynamic array
Dim arr() As Variant
Dim rg As Range


Set rg = AllSheet.Cells(n, 1).CurrentRegion
' Read values to array
arr = rg.Value

' Write the values back sheet
.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Value = arr