VBA粘贴范围

我有简单的目标复制范围和粘贴到另一个spreadsheet 。 下面的code给出了副本，但不粘贴。

 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 

有什么build议么？

Answer 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和激活：

 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永远不会改变代码，可以进一步简化为：

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

我添加了“从范围内复制”和“ Resize属性，使其稍微更具dynamic性，以防将来使用其他范围。

Answer 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 

Answer 3

这是我试图复制粘贴excel范围与它的大小和单元格组合。 这可能是有点太具体的我的问题，但…：

'**'将表格从一个地方复制到另一个地方'TargetRange：在哪里放置新的LayoutTable'typee：如果它是Instalation Layout表格（1）或Package Layout表格（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 

'**'接收粘贴的表格范围，并相应地将其属性'原始的复制表格'重新sorting：如果它是一个Instalation Layout表格（1）或Package Layout表格（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