复制不相邻的单元格并粘贴转置但不能复制到整行

Question

Sheet

Code

代码开头TargetRow的值为0.执行TargetRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1时，值为2.当脚本重新运行时，TargetRow再次从0开始。 / p>

Sub TransferData()

Dim wsSource As Worksheet  'define source worksheet
Set wsSource = Worksheets("Form")

Dim wsTarget As Worksheet  'define target worksheet
Set wsTarget = Worksheets("DB")

Dim TargetRow As Long 'don't use Integer. Excel has more rows than Integer can handle.
TargetRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1 'last used row + 1

'copy ticket data
wsSource.Range("TicketData").Copy
wsTarget.Range("F" & TargetRow).PasteSpecial Paste:=xlValues, Transpose:=True

'copy scores
wsSource.Range("Scores").Copy
wsTarget.Range("Q" & TargetRow).PasteSpecial Paste:=xlValues, Transpose:=True

End Sub

Answer 1

我假设你想要粘贴到同一行。因此，我建议首先确定下一个空行，然后将其用于复制/粘贴操作。

Dim wsSource As Worksheet  'define source worksheet
Set wsSource = Worksheets("Form")

Dim wsTarget As Worksheet  'define target worksheet
Set wsTarget = Worksheets("DB")

Dim TargetRow As Long 'don't use Integer. Excel has more rows than Integer can handle.
TargetRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1 'last used row + 1

'copy ticket data
wsSource.Range("TicketData").Copy
wsTarget.Range("A" & TargetRow).PasteSpecial Paste:=xlValues, Transpose:=True

'copy scores
wsSource.Range("Scores").Copy
wsTarget.Range("R" & TargetRow).PasteSpecial Paste:=xlValues, Transpose:=True