VBA糊范围
VBA糊范围
提问于 2013-09-23 21:04:00
我想复制一个范围并将其粘贴到另一个电子表格中。下面的代码将获得副本，但不会粘贴：
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我怎样才能把副本粘贴到另一张纸上呢？
回答 4
Stack Overflow用户
回答已采纳
发布于 2013-09-23 21:17:53
要从字面上修复您的示例，您可以使用以下方法：
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若要对其稍作改进，就等于摆脱了“选择和激活”：
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我添加了range的副本，并添加了Resize属性，以使其更加动态，以防将来有其他希望使用的范围。
Stack Overflow用户
发布于 2013-09-24 15:07:31
我会试着
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").pasteStack Overflow用户
发布于 2014-08-22 10:56:00
这就是我在试图复制excel范围和它的大小和单元格组时得出的结果。对我的问题来说可能有点太具体了，但是.
“**”从一个地方复制一个表到另一个地方'TargetRange:放置新的LayoutTable‘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“**”接收粘贴的表范围和rearranjes它的属性“相应于原始的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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/18968856
复制相关文章
相似问题
腾讯云开发者
