选取内容怎么分别复制到不同列

Ericcccccc

原来复制整列内容时用Selection.Copy Destination就好了，但有个情况是，粘贴的列区域不够需要再第二列接下来继续粘贴时，该怎么用vba实现？比如下面：

行标题1	行标题2	行标题6	行标题8	行标题9
A1		A1		A6
A2		A2		A7
A3		A3		A8
A4		A4
A5	选取A1-A8	A5
A6	共8个
A7		目的结果		目的结果
A8		不超过5个时都在C列		第6个开始在E列
A9
		每列最多5个

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Set Rng = Application.Intersect(Columns(1), ActiveSheet.UsedRange, Selection)
   
4.     If Not Rng Is Nothing Then
   
5.         If Rng.Cells.Count = 1 Then
   
6.             [c2] = Rng.Value
   
7.         Else
   
8.             arr = Rng
   
9.             c = 3
   
10.             For j = 1 To UBound(arr) Step 5
    
11.                 r = 2
    
12.                 For i = j To WorksheetFunction.Min(j + 4, UBound(arr))
    
13.                     Cells(r, c) = arr(i, 1)
    
14.                     r = r + 1
    
15.                 Next i
    
16.                 c = c + 2
    
17.             Next j
    
18.         End If
    
19.     End If
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

Ericcccccc

liulang0808 发表于 2018-9-26 16:46
附件内容供参考。。。。。。

太感谢了，能实现需要的功能，好好学习代码