我正在尝试自动复制和粘贴表“ CMJ”上某个范围(T3:AH3)中数据的复制和粘贴,该操作是通过在同一表上选择命名范围(Unique_Names)中的名称而生成的。粘贴将出现在最底部一行“ DataSheet”上的数据表中,并且仅粘贴为文本。
我对VBA几乎没有经验,并且尝试过各种代码行,到目前为止,以下代码效果最好。但是,当我运行下面的代码时,将列表中的名字复制并粘贴大约50次,并且从不遍历其余名字。
Sub LoopandCopy()
Sheets("CMJ").Select
Dim x As Range
For Each x In Sheets("CMJ").Range("Unique_Names")
Range("T3:AH3").Copy
Sheets("DataSheet").Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next x
End Sub
答案 0 :(得分:0)
未经测试,写在电话上。如果我理解正确,您想复制工作表"T3:AH3"
上的范围CMJ
并粘贴到工作表DataSheet
上的特定行。
Sub LoopandCopy()
With thisworkbook
Dim rangeToCopy as range
Set rangeToCopy = .worksheets("CMJ").Range("T3:AH3")
With .worksheets("DataSheet")
Dim rowToPasteTo as long
rowToPasteTo = .Range("A200").End(xlUp).Offset(1, 0).row
.cells(rowToPasteTo, "A").resize(rangeToCopy.rows.count, rangetocopy.columns.count).value2 = rangetocopy.value2
End with
End with
End sub
上面的方法不是复制粘贴,而是将一个范围的值分配给另一个范围(大小相同)。
答案 1 :(得分:0)
我在这里猜测唯一值在一栏中。
将其放入CMJ工作表代码:
Option Explicit
Private TargetValue As Variant
Sub LoopandCopy()
Const cSource As Variant = "CMJ" ' Source Worksheet Name/Index
Const cTarget As Variant = "DataSheet" ' Target Worksheet Name/Index
Const cStrUnique As String = "Unique_Names" ' Named Range
Const cStrSource As String = "T3:AH3" ' Source Range
Const cTargetColumn As Variant = "A" ' Column Letter/Number
Dim i As Long ' Named Range Cells Counter
Dim lngLastRow As Long ' Target Last Row
Dim vntSource As Variant ' Source Array
' Calculate Target Last Row.
lngLastRow = Worksheets(cTarget).Cells(Rows.Count, cTargetColumn) _
.End(xlUp).Row
With Worksheets(cSource)
' Paste Source Range into Source Array.
vntSource = .Range(cStrSource)
For i = 1 To .Range(cStrUnique).Cells.Count
' Resize the cell at the intersection of Target Last Row and
' Target Column by the size of Source Array.
Worksheets(cTarget).Cells(lngLastRow + i, cTargetColumn) _
.Resize(, UBound(vntSource, 2)) = vntSource
Next
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Not Intersect(Worksheets("CMJ").Range("N7"), Target) Is Nothing Then
If Target.Value <> TargetValue Then LoopandCopy
TargetValue = Target.Value
End If
End If
End Sub