vba VBA粘贴范围

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/18968856/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 16:42:24  来源:igfitidea点击:

VBA paste range

excelvbarangepaste

提问by user1700890

I have simple goal of copying range and pasting it into another spreadsheet. The following code below gives copies, but does not paste.

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

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

Any suggestions?

有什么建议?

回答by user2140261

To literally fix your example you would use this:

要从字面上修复您的示例,您将使用以下命令:

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

To Make slight improvments on it would be to get rid of the Select and Activates:

对其稍作改进将摆脱 Select 和 Activates:

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

but using the clipboard takes time and resources so the best way would be to avoid a copy and paste and just set the values equal to what you want.

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

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

To define the CopyFromyou can use anything you want to define the range, You could use Range("A2:A65"), Range("A2",[A65]), Range("A2", "A65")all would be valid entries. also if the A2:A65 Will never change the code could be further simplified to:

要定义CopyFrom您可以使用任何您想定义范围的东西,您可以使用Range("A2:A65"), Range("A2",[A65])Range("A2", "A65")所有这些都是有效的条目。此外,如果 A2:A65 永远不会改变代码可以进一步简化为:

Sub Normalize()

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

End Sub

I added the Copy from range, and the Resizeproperty to make it slightly more dynamic in case you had other ranges you wanted to use in the future.

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

回答by John Moore

I would try

我会尝试

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

回答by Twimnox75

This is what I came up to when trying to copy-paste excel ranges with it's sizes and cell groups. It might be a little too specific for my problem but...:

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

'** 'Copies a table from one place to another 'TargetRange: where to put the new LayoutTable 'typee: If it is an Instalation Layout table(1) or Package Layout table(2) '**

'** '将表从一个地方复制到另一个地方 'TargetRange:放置新布局表的位置 'typee:如果它是安装布局表 (1) 或包布局表 (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

'** 'Receives the Pasted Table Range and rearranjes it's properties 'accordingly to the original CopiedTable 'typee: If it is an Instalation Layout table(1) or Package Layout table(2) '**

'** '接收粘贴的表格范围并重新排列它的属性'根据原始的CopiedTable'typee:如果它是安装布局表(1)或包布局表(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