繁体   English   中英

将一个工作表中一列中的单元格区域复制到另一工作表中一行中的指定单元格中

[英]Copying a range of cells in a column in one sheet to specified cells in a row in another

我一直在四处寻找答案,但是在编写VB代码时我感到非常环保,因此我需要在如何编写代码方面获得具体帮助。 我的复制粘贴冒险都没有成功,所以希望您对我耐心等待。

我当前的代码是这样的:

    Sub CopyPaste()

Dim targetRng As Excel.Range
Dim destRng As Excel.Range
Set targetRng = Range("K6:K14,K19:K20")

With Excel.ThisWorkbook.Sheets("Database")
    Set destRng = .Cells(2, .Columns.Count).End(Excel.xlToLeft).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
    destRng.Value = targetRng.Value
End With

With Excel.ThisWorkbook.Sheets("Email")
Range("J6:J14,J19:J20").ClearContents
End With

End Sub

...效果很好,除了我要在行中而不是列中发布数据。 (注意,要复制的目标范围是K列,要清除的范围是J-是正确的,因为J列具有可供选择的下拉列表)

所以我怀疑我需要添加的代码是:

.PasteSpecial Paste:=xlPasteValues, Transpose:=True

但是我无法终生想出如何或在哪里得到它,而我所遇到的所有错误都是在努力。

另外,我要复制的数据是一个有间隔(K6:K14,K19:K20)的范围,但是第二个范围(K19:K20)不会粘贴到“数据库”表中。 .ClearContents函数对于J列范围内的两个集都可以正常工作,因此我也看不到哪里错了。

可怜代码新手吗?

您尝试执行的操作似乎不适用于多个选择。 不幸的是,VBA中的调试信息不​​是最好的,因此我倾向于进行一些错误处理,以使信息更丰富。

Sub Test()

On Error GoTo err_handler

    Dim copyRange As Excel.Range
    Set copyRange = Sheets("Sheet1").Range("A1:A10,A13:A14")
    Dim pasteRange As Excel.Range
    Set pasteRange = Sheets("Sheet1").Range("C1:L1,O1:P1")

    copyRange.Copy
    pasteRange.PasteSpecial Paste:=xlPasteValues, Transpose:=True

    Exit Sub

err_handler:
    MsgBox (Err.Description)

End Sub

当运行此代码并捕获错误时,我会看到以下消息

此操作不适用于多项选择

如果我按照以下方式将范围划分出来,那么它将按预期工作。

Sub Test()

On Error GoTo err_handler

    Dim copyRange As Excel.Range
    Set copyRange = Sheets("Sheet1").Range("A1:A10")
    Dim pasteRange As Excel.Range
    Set pasteRange = Sheets("Sheet1").Range("C1:L1")

    copyRange.Copy
    pasteRange.PasteSpecial Paste:=xlPasteValues, Transpose:=True

    Set copyRange = Sheets("Sheet1").Range("A13:A14")
    Set pasteRange = Sheets("Sheet1").Range("O1:P1")

    copyRange.Copy
    pasteRange.PasteSpecial Paste:=xlPasteValues, Transpose:=True

    Exit Sub

err_handler:
    MsgBox (Err.Description)

End Sub

我希望这有帮助。

干杯克里斯

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM