【问题标题】:VBA paste rangeVBA粘贴范围
【发布时间】:2013-09-28 21:59:33
【问题描述】:

我的简单目标是复制范围并将其粘贴到另一个电子表格中。下面的代码提供副本,但不粘贴。

Sub Normalize()

    Dim Ticker As Range
    Sheets("Sheet1").Activate
    Set Ticker = Range(Cells(2, 1), Cells(65, 1))
    Ticker.Copy

    Sheets("Sheet2").Select
    Cells(1, 1).Activate
    Ticker.PasteSpecial xlPasteAll

End Sub

有什么建议吗?

【问题讨论】:

  • Ticker.PasteSpecial 正在粘贴回您复制的同一范围。
  • 谢谢!但是如何将范围复制并粘贴到不同的工作表?

标签: excel vba range paste


【解决方案1】:

要从字面上修正你的例子,你会使用这个:

Sub Normalize()


    Dim Ticker As Range
    Sheets("Sheet1").Activate
    Set Ticker = Range(Cells(2, 1), Cells(65, 1))
    Ticker.Copy

    Sheets("Sheet2").Select
    Cells(1, 1).PasteSpecial xlPasteAll



End Sub

稍微改进一下就是去掉 Select 和 Activates:

Sub Normalize()
    With Sheets("Sheet1")
        .Range(.Cells(2, 1), .Cells(65, 1)).Copy Sheets("Sheet2").Cells(1, 1)
    End With
End Sub

但使用剪贴板需要时间和资源,因此最好的方法是避免复制和粘贴,只需将值设置为您想要的值。

Sub Normalize()
Dim CopyFrom As Range

Set CopyFrom = Sheets("Sheet1").Range("A2", [A65])
Sheets("Sheet2").Range("A1").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value

End Sub

要定义CopyFrom,您可以使用任何您想定义的范围,您可以使用Range("A2:A65")Range("A2",[A65])Range("A2", "A65"),所有这些都是有效的条目。另外如果 A2:A65 Will never change 代码可以进一步简化为:

Sub Normalize()

Sheets("Sheet2").Range("A1:A65").Value = Sheets("Sheet1").Range("A2:A66").Value

End Sub

我添加了 Copy from range 和 Resize 属性以使其更加动态,以防您将来想使用其他范围。

【讨论】:

  • 这只会让你得到值而不是格式......我想我可能是错的,但用户也想粘贴格式? icker.PasteSpecial xlPasteAll
  • @user1700890 没有错误?是因为你想要 Sid 所说的格式吗?
  • 不,我不关心格式,代码的最后一部分既不会产生错误也不会产生结果。如果我是Sheet2,会产生error: 1004 Application-defined or object-defined error。并将突出显示行 Set CopyFrom = Sheets("Sheet1").Range("A2", [A65])
  • @user1700890 :我通过 :@user2140261 测试了上面的第二段代码,它对我有用 :)
  • 您可以通过将 .Value 更改为 .Value(11) 来包含格式设置,如 here 所述
【解决方案2】:

我会试试的

Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy

Worksheets("Sheet2").Range("A1").Offset(0,0).Cells.Select
Worksheets("Sheet2").paste

【讨论】:

    【解决方案3】:

    这是我在尝试复制粘贴 excel 范围及其大小和单元组时想到的。对于我的问题来说,这可能有点太具体了,但是......:

    '** '将表格从一个地方复制到另一个地方 'TargetRange: 新的 LayoutTable 放在哪里 'typee: 如果是Instalation Layout table(1) 或Package Layout table(2) '**

    Sub CopyLayout(TargetRange As Range, typee As Integer)
        Application.ScreenUpdating = False
            Dim ncolumn As Integer
            Dim nrow As Integer
    
            SheetLayout.Activate
        If (typee = 1) Then 'is installation
            Range("installationlayout").Copy Destination:=TargetRange '@SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!@@@@@
        ElseIf (typee = 2) Then 'is package
            Range("PackageLayout").Copy Destination:=TargetRange '@SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!@@@@@
        End If
    
        Sheet2.Select 'SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!@@@@@
    
        If typee = 1 Then
           nrow = SheetLayout.Range("installationlayout").Rows.Count
           ncolumn = SheetLayout.Range("installationlayout").Columns.Count
    
           Call RowHeightCorrector(SheetLayout.Range("installationlayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
        ElseIf typee = 2 Then
           nrow = SheetLayout.Range("PackageLayout").Rows.Count
           ncolumn = SheetLayout.Range("PackageLayout").Columns.Count
           Call RowHeightCorrector(SheetLayout.Range("PackageLayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
        End If
        Range("A1").Select 'Deselect the created table
    
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub
    

    '** '接收粘贴的表格范围并重新排列它的属性 '根据原来的CopiedTable 'typee: 如果是Instalation Layout table(1) 或Package Layout table(2) '**

    Function RowHeightCorrector(CopiedTable As Range, PastedTable As Range, typee As Integer, RowCount As Integer, ColumnCount As Integer)
        Dim R As Long, C As Long
    
        For R = 1 To RowCount
            PastedTable.Rows(R).RowHeight = CopiedTable.CurrentRegion.Rows(R).RowHeight
            If R >= 2 And R < RowCount Then
                PastedTable.Rows(R).Group 'Main group of the table
            End If
            If R = 2 Then
                PastedTable.Rows(R).Group 'both type of tables have a grouped section at relative position "2" of Rows
            ElseIf (R = 4 And typee = 1) Then
                PastedTable.Rows(R).Group 'If it is an installation materials table, it has two grouped sections...
            End If
        Next R
    
        For C = 1 To ColumnCount
            PastedTable.Columns(C).ColumnWidth = CopiedTable.CurrentRegion.Columns(C).ColumnWidth
        Next C
    End Function
    
    
    
    Sub test ()
        Call CopyLayout(Sheet2.Range("A18"), 2)
    end sub
    

    【讨论】:

      【解决方案4】:

      您可以执行以下操作以将值粘贴到其他范围内。 (比复制和粘贴值更快)

      ThisWorkbook.WorkSheets("Sheet2").Range("A1:A2").Value = Sheets`("Sheet1").Range("A1:A2").Value
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2018-09-27
        • 2014-04-08
        • 1970-01-01
        • 2014-11-21
        相关资源
        最近更新 更多