Question

我需要将各个列中的数据复制到彼此不相邻且具有可变行数（但该变量对每列具有相同值）。

到目前为止我的代码如下：

 Set MyXL = CreateObject("Excel.Application")
 MyXL.Workbooks.Add
 MyXL.Worksheets(1).Name = SheetName 

 Set shtData = Worksheets("Data")
 rngDataRowCount = shtData.Range("A1048576").End(xlUp).Row
 Set rngData = shtData.Range("A1:I" & rngDataRowCount)
 rngData.Copy

 MyXL.Worksheets(SheetName).Activate
 MyXL.Worksheets(SheetName).Paste
 Range("A1").Select

只要列彼此相邻但不允许我添加其他列，哪个工作正常。

我希望我可以做类似的事情：

     Set rngData = shtData.Range("A1:I, N1:N, P1:R" & rngDataRowCount)

但这句话失败了。或者有什么方法我可以设置多个范围，然后附加到剪贴板？当然，任何帮助都是值得赞赏的。

编辑：为了澄清我想要实现的目标，让我说我有下表：

 _________________________________________________________
 | col1 | col2 | col3 | col4 | col5 | col6 | col7 | col8 |
 _________________________________________________________
 | q    | w    | e    | r    | t    | y    | u    | i    |
 _________________________________________________________
 | q    | w    | e    | r    | t    | y    | u    | i    |
 _________________________________________________________

我希望能够选择一个范围，例如col1，col2，col5和col8，以便一次性复制这些列中的所有填充单元格，以便粘贴给我这个：

 _____________________________
 | col1 | col2 | col5 | col8 |
 _____________________________
 | q    | w    | t    | i    |
 _____________________________
 | q    | w    | t    | i    |
 _____________________________

Answer 1

我认为这可能是一个想法，只是为了使用循环。

编辑以明确说明：因此，您将分别复制每一列。将保留逐个拷贝的订单。如果保持恒定的目标范围规则，则每列将以相同的顺序复制到适当的范围内。

Sub Answer()
    Dim shtData As Worksheet
    Set shtData = Worksheets("Data")
    Dim rngDataRowCount
    rngDataRowCount = shtData.Range("A1048576").End(xlUp).Row
    Dim rngData As Range

    '<--start of modification
    Dim rngCol As Range
    Set rngData = shtData.Range("A1:I" & rngDataRowCount & _
                    ",N1:N" & rngDataRowCount & _
                    ",P1:R" & rngDataRowCount)

'<---variant A- keep columns separated into destination range
    For Each rngCol In rngData.Columns
         rngCol.Copy rngCol.Offset(0, 20)   'here, 20 columns to right
    Next
**'here edited**

'<---variant B- copy columns into new location, united, no loop
         rngData.Copy Range("zz1")           'here, set destination as single top-left cell
End Sub

一个提示 - 如果您将列复制到其他范围使用语法Range.Copy destinationRange

MS Excel VBA - 选择多个不同的动态范围

1 个答案: